API: Drawing images on an Access form

This is a question that pops up every so often on Access newsgroups.  A developer wants to draw images on a form using API functions.  Unfortunately, almost all graphics code that works on VB forms fails in Access because Access forms

1. were not meant to be drawn upon, and
2. they are already very heavily subclassed.

To prove these points, here's a sample that does and doesn't work. 

The main issue in drawing on Access forms is working with the right hWnd and hDC.   The built in hWnd property of a form is actually bound to the form's RecordSelector window.  The client area of a form is a different window whose hWnd we have to locate in order to draw successfully.  But that's not all!  To maintain that image on the form,  you have to basically redraw that image each time the window receives a WM_PAINT message from Windows.  This means that you have to subclass the window, a technique that's

1. not supported or recommended in Access 97 environment (VBA5);  ( See AddressOf) and
2. although supported in Access 2000 environment (VBA6), is still not recommended.

If you run sDrawImageOnForm sub from a command button on a form, you'll notice that the image will not get redrawn if you send the form to the background or move another window on top of it.

'*********** Code Start ************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
'   structure defines the coordinates of the upper-left and
'   lower-right corners of a rectangle.
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
'   retrieves the name of the class to which the specified window belongs.
Private Declare Function apiGetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hWnd As Long, _
    ByVal lpClassname As String, _
    ByVal nMaxCount As Long) _
    As Long
 
'   retrieves a handle to a window that has the specified relationship
'   (Z order or owner) to the specified window.
Private Declare Function apiGetWindow Lib "user32" _
    Alias "GetWindow" _
    (ByVal hWnd As Long, _
    ByVal wCmd As Long) _
    As Long
 
'   StretchBlt function copies a bitmap from a source rectangle into a
'   destination rectangle, stretching or compressing the bitmap to fit
'   the dimensions of the destination rectangle, if necessary. The system
'   stretches or compresses the bitmap according to the stretching mode currently
'   set in the destination device context.
Private Declare Function apiStretchBlt Lib "gdi32" _
    Alias "StretchBlt" _
    (ByVal hDC 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 nSrcWidth As Long, _
    ByVal nSrcHeight As Long, _
    ByVal dwRop As Long) _
    As Long
 
'   function retrieves a handle to a display device context (DC) for the client
'   area of a specified window or for the entire screen.
Private Declare Function apiGetDC Lib "user32" _
    Alias "GetDC" _
    (ByVal hWnd As Long) _
    As Long
 
'   releases a device context (DC), freeing it for use by other applications.
Private Declare Function apiReleaseDC Lib "user32" _
    Alias "ReleaseDC" _
    (ByVal hWnd As Long, _
    ByVal hDC As Long) _
    As Long
 
'   retrieves the dimensions of the bounding rectangle of the specified window.
Private Declare Function apiGetWindowRect Lib "user32" _
    Alias "GetWindowRect" _
    (ByVal hWnd As Long, _
    lpRect As RECT) _
    As Long
 
'   function sets the bitmap stretching mode in the specified device context.
Private Declare Function apiSetStretchBltMode Lib "gdi32" _
    Alias "SetStretchBltMode" _
    (ByVal hDC As Long, _
    ByVal nStretchMode As Long) _
    As Long
 
'  handle identifies the child window at the top of the Z order,
'  if the specified window is a parent window
Private Const GW_CHILD = 5
'   Returns a handle to the window below the given window.
Private Const GW_HWNDNEXT = 2
Private Const MAX_LEN = 255
'  class name for an Access form's client window
Private Const ACC_FORM_CLIENT_CLASS = "OFormSub"
'   class name for the child window of an Access form's Client window
Private Const ACC_FORM_CLIENT_CHILD_CLASS = "OFEDT"
'   Copies the source rectangle directly to the destination rectangle.
Private Const SRCCOPY = &HCC0020
'   Maps pixels from the source rectangle into blocks of pixels in
'   the destination rectangle. The average color over the destination block
'   of pixels approximates the color of the source pixels.
Private Const STRETCH_HALFTONE& = 4
'   Performs a Boolean AND operation using the color values for the
'   eliminated and existing pixels. If the bitmap is a monochrome bitmap,
'   this mode preserves black pixels at the expense of white pixels.
Private Const STRETCH_ORSCANS& = 2
 
 
Sub sDrawImageOnForm(frm As Form)
'   Takes a snapshot of the Access window,
'   and draws it on the client area of the
'   specified form
'
Dim hWnd As Long, hWndSrc As Long
Dim hDCSrc As Long
Dim hDCDest As Long
Dim lpRectSrc As RECT
Dim lpRectDest As RECT
 
    '   Get a handle to the Client area window
    '   of the specified form
    hWnd = fGetClientHandle(frm)
    If hWnd = 0 Then Exit Sub
 
    hWndSrc = hWndAccessApp
    '   get the Device Contexts
    hDCSrc = apiGetDC(hWndSrc)
    hDCDest = apiGetDC(hWnd)
    '   get the source and destination rectangles
    Call apiGetWindowRect(hWndSrc, lpRectSrc)
    Call apiGetWindowRect(hWnd, lpRectDest)
 
    '   set a Stretch (should be shrink actually) mode
    Call apiSetStretchBltMode(hDCDest, STRETCH_ORSCANS)
    With lpRectDest
        '   copy the rectangle from source to destination rect.
        Call apiStretchBlt(hDCDest, 0, 0, .Right - .Left, .Bottom - .Top, _
                hDCSrc, 0, 0, lpRectSrc.Right - lpRectSrc.Left, _
                lpRectSrc.Bottom - lpRectSrc.Top, SRCCOPY)
    End With
    '   clean up by releasing the device contexts
    Call apiReleaseDC(hWnd, hDCDest)
    Call apiReleaseDC(hWndSrc, hDCSrc)
End Sub
 
 
Function fGetClientHandle(frm As Form) As Long
'   Returns a handle to the client window of a form
'   An Access form's hWnd is actually bound to the
'   recordselector "window"
'
Dim hWnd As Long
 
    '   get the first child window of the form
    hWnd = apiGetWindow(frm.hWnd, GW_CHILD)
 
    '   iterate through all child windows of the form
    Do While hWnd
        '   if we locate the client area whose class name is "OFormSub"
        If fGetClassName(hWnd) = ACC_FORM_CLIENT_CLASS Then
            '   the Client window's child is a window with the class
            '   name of OFEDT, so just verify that we're looking at the
            '   right window
            If fGetClassName(apiGetWindow( _
                hWnd, GW_CHILD)) = _
                    ACC_FORM_CLIENT_CHILD_CLASS Then
                            '   if we found a match, then return
                            '   the handle and we're outta here.
                            fGetClientHandle = hWnd
                            Exit Do
            End If
        End If
        '   get a handle to the next child window
        hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
    Loop
End Function
 
Private Function fGetClassName(hWnd As Long) As String
    Dim strBuffer As String
    Dim lngCount As Long
 
    strBuffer = String$(MAX_LEN - 1, 0)
    lngCount = apiGetClassName(hWnd, strBuffer, MAX_LEN)
    If lngCount > 0 Then
        fGetClassName = Left$(strBuffer, lngCount)
    End If
End Function
'*********** Code End ************