Binaryworld - How to create memory DC and bitmap using CreateCompatibleDC and Create ... [ VB -> Bitmap ]

In this article you will learn how to create a DC in memory and create a bitmap for that DC with a specified height and width. To create memory bitmap you have to do the following steps

CreateCompatibleDC to create the memory DC.
CreateCompatibleBitmap (potential pitfall - use the UserControl DC for compatibility, *not* the memory DC!).
SelectObject to select the compatible bitmap into the memory DC. Note the hDC returned from this call, you'll need it in step 6.
Use API functions to draw on the memory DC
BitBlt from the memory DC to the UserControl DC.
SelectObject to select the old bitmap (from step 3) into the memory DC.
DeleteObject to delete the compatible bitmap
DeleteDC to delete the memory DC.

Step-By-Step Example

- Create a standard exe project, Form1 is added by default
- Place one commandbutton and one PictureBox on the form1
- Place the following code in form1 code window

Click here to copy the following block

Option Explicit

Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" ( _
    ByVal hdc As Long, ByVal x As Long, _
    ByVal y As Long, lpPoint As Long) As Long

Private Declare Function LineTo Lib "gdi32" ( _
    ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDestDC As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hSrcDC As Long, _
    ByVal xSrc As Long, ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long) As Long

Private Declare Function GetStockObject Lib "gdi32" ( _
    ByVal nIndex As Long) As Long

Private Declare Function Rectangle Lib "gdi32" ( _
    ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _
    ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( _
    ByVal H As Long, ByVal W As Long, ByVal E As Long, _
    ByVal O As Long, ByVal W As Long, ByVal I As Long, _
    ByVal u As Long, ByVal S As Long, ByVal C As Long, _
    ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
    ByVal PAF As Long, ByVal F As String) As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" ( _
    ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
    ByVal lpString As String, ByVal nCount As Long) As Long

Private Declare Function SetBkMode Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Declare Function GetBkMode Lib "gdi32" ( _
    ByVal hdc As Long) As Long

Private Const SRCCOPY = &HCC0020
Private Const ANSI_CHARSET = 0

Private Const BLACK_PEN = 7
Private Const WHITE_BRUSH = 0
Private Const NULL_BRUSH = 5
Private Const TRANSPARENT = 1

Private Sub Command1_Click()
  CreateBitmapAndShow
End Sub

Private Sub CreateBitmapAndShow()
  Dim mem_dc As Long
  Dim mem_bm As Long
  Dim orig_bm As Long
  Dim wid As Long
  Dim hgt As Long
  Dim old_font As Long
  Dim new_font As Long
  Dim old_bk_mode As Long

  Picture1.ScaleMode = vbPixels
  wid = Picture1.ScaleWidth
  hgt = Picture1.ScaleHeight

  ' Create the device context.
  mem_dc = CreateCompatibleDC(hdc)

  ' Create the bitmap.
  mem_bm = CreateCompatibleBitmap(mem_dc, wid, hgt)

  ' Make the device context use the bitmap.
  orig_bm = SelectObject(mem_dc, mem_bm)

  ' Give the device context a white background.
  SelectObject mem_dc, GetStockObject(WHITE_BRUSH)
  Rectangle mem_dc, 2, 2, wid - 2, hgt - 2
  SelectObject mem_dc, GetStockObject(NULL_BRUSH)

  ' Draw the on the device context.
  SelectObject mem_dc, GetStockObject(BLACK_PEN)
  MoveToEx mem_dc, 0, 0, ByVal 0&
  LineTo mem_dc, wid, hgt
  MoveToEx mem_dc, 0, hgt, ByVal 0&
  LineTo mem_dc, wid, 0

  ' Do not fill the background.
  old_bk_mode = GetBkMode(mem_dc)
  SetBkMode mem_dc, TRANSPARENT

  Dim nHeight, nWidth, nEscapement, nOrientation, fnWeight, _
      fdwItalic, fdwUnderline, fdwStrikeOut, fdwCharSet, fdwOutputPrecision, _
      fdwClipPrecision, fdwQuality, fdwPitchAndFamily, lpszFace

  'New font properties .

  nHeight = 7                    ' height of font
  nWidth = 7                    ' average character width
  nEscapement = 400                 ' angle of escapement
  nOrientation = 0                 ' base-line orientation angle
  fnWeight = 0                   '700 =Bold       ' font weight
  fdwItalic = 0                   ' italic attribute option
  fdwUnderline = 1                 ' underline attribute option
  fdwStrikeOut = 0                 ' strikeout attribute option
  fdwCharSet = ANSI_CHARSET             ' character set identifier
  fdwOutputPrecision = 0              ' output precision
  fdwClipPrecision = 0               ' clipping precision
  fdwQuality = 0                  ' output quality
  fdwPitchAndFamily = 0               ' pitch and family
  lpszFace = "Courier New"             ' typeface name

  new_font = CreateFont(nHeight, _
      nWidth, _
      nEscapement, _
      nOrientation, _
      fnWeight, _
      fdwItalic, _
      fdwUnderline, _
      fdwStrikeOut, _
      fdwCharSet, _
      fdwOutputPrecision, _
      fdwClipPrecision, _
      fdwQuality, _
      fdwPitchAndFamily, _
      lpszFace)

  old_font = SelectObject(mem_dc, new_font)

  ' Draw some text.
  TextOut mem_dc, 5, Picture1.ScaleHeight - 20, Now(), Len(Now())

  ' Destroy the new font.
  SelectObject mem_dc, old_font
  DeleteObject new_font

  ' Restore the original background fill mode.
  SetBkMode mem_dc, old_bk_mode

  ' Copy the device context into the PictureBox.
  Picture1.AutoRedraw = True

  '//Copy our image drawn on memory dc to picturebox dc
  BitBlt Picture1.hdc, 0, 0, wid, hgt, _
      mem_dc, 0, 0, SRCCOPY

  Picture1.Refresh

  ' Delete the bitmap and dc.
  SelectObject mem_dc, orig_bm
  DeleteObject mem_bm
  DeleteDC mem_dc
End Sub

Private Sub Form_Load()
  Picture1.AutoRedraw = True
  Command1.Caption = "<< Create Bitmap In Memory and Display"
End Sub

- Press F5 to run the project