Creating Custom MDI Form Backgrounds

Code Listing 1 and Listing 2

Listing 1

  Option Explicit
  GetWindow() Constants
  Private Const GW_CHILD = 5
  Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  Const COLOR_BACKGROUND = 1

  Private Const 

  Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type

  ' Bitmap Header Definition
  Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
  End Type

Listing 2

  Private Sub SubClass1_WndMessage(hwnd As Long, msg As Long, wp As Long, lp As Long, retval As Long, nodef As Integer)
    Dim tdc&
    Dim usedc&
    Dim oldbm&
    Dim bm As BITMAP
    Dim rc As RECT
    Dim offsx&, offsy&
    
    ' Get a DC to draw into
    usedc = wp

    ' Create a compatible DC to use
    tdc = CreateCompatibleDC(usedc)

    ' Gets the bitmap handle of the background bitmap
    oldbm = SelectObject(tdc, Picture1.Picture)
    Call GetObjectAPI(Picture1.Picture, Len(bm), bm)
    Call GetClientRect(hwnd, rc)

    ' Decide where to place the MDI client logo
    offsx = 20
    offsy = 20

    ' Set the clipping region to the entire window -
    ' necessary because the hDC provided has a clipping
    ' region set.
    Call SelectClipRgn(usedc, 0)
    
    ' We exclude the bitmap area - this reduces flicker (try removing it)
    Call ExcludeClipRect(usedc, offsx, offsy, offsx +	 bm.bmWidth, offsy + bm.bmHeight)
    Call FillRect(usedc, rc, COLOR_BACKGROUND)
    
    ' And restore the clip region before painting the bitmap
    Call SelectClipRgn(usedc, 0)
    
    Call BitBlt(usedc, offsx, offsy, bm.bmWidth, bm.bmHeight, tdc, 0, 0, SRCCOPY)
    
    Call SelectObject(tdc, oldbm)
    Call DeleteDC(tdc)
    nodef = True
    retval = True
  End Sub



[HOME] [TABLE OF CONTENTS] [SEARCH]