APIs: Dessiner une image sur un formulaire Access	Author(s) Dev Ashish

Dessiner une image sur un formulaire Access.

Cette question est souvent demandée dans les groupes de discussions d'Access: un développeur désire dessiner une image sur un formulaire en utilisant les fonctions API. Malheureusement, pratiquement tout le code graphique qui fonctionne en VB ne produit pas l'effet escompté en Access:

1. les formulaires Access ne sont pas conçus pour cela, <g> et
2. ils sont déjà fortement sous classés.

Pour prouver ce point, voici un exemple qui fonctionne et ne fonctionne pas. 

En essayant de dessiner sur un formulaire Access, le problème est de repérer le bon hWnd et le bon hDC.   La propriété hWnd fournie est actuellement celle liée au sélecteur d'enregistrement ( RecordSelector ).  La portion client du formulaire est une fenêtre différente dont il faut trouver le hWnd pour y dessiner avec succès.  Mais ce n'est pas tout! Pour maintenir l'image sur le formulaire, il faut le retracer chaque fois que la fenêtre reçoit le message WM_PAINT depuis Windows.  Cela implique qu'on utilise une technique pour sous classer la fenêtre, mais c'est une technique qui

1. n'est pas supportée ni recommandée sous  Access 97  (VBA5);  ( Voir AddressOf) et
2. même si elle est supportée sous  Access 2000  (VBA6), elle n'est toujours pas recommandée.

Si vous lancez sDrawImageOnForm depuis un bouton sur un formulaire, vous noterez que l'image n'est pas retracée si vous envoyez le formulaire en background ou si vous le recouvrez par une autre fenêtre.

'*********** Code Start ************
'   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)
    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 ************

Pour une situation qui peut s'accommoder d'un hDC, on peut également se référer à   ImageClass de Stephen Lebans