ACC: How to Capture Screen Shots of Your Forms (1.x/2.0)

MORE INFORMATION

The following sample Access Basic code will capture an object on the screen to the Clipboard. Note that you can change the handle AccessHwnd in the sample code below to create screen captures of other applications, including specific objects within Microsoft Access.

After capturing a screen, you can open Paintbrush (PBRUSH.EXE) and choose the Paste command from the Edit menu. The screen capture from Microsoft Access will be loaded into the Paintbrush window.

To run this code, call the ScreenDump() function from an event, a macro, or the module's Immediate window. To run ScreenDump() from the Immediate window, type the following, and then press ENTER:

?ScreenDump()

To set up the ScreenDump() function, open a new or existing module and insert the code listed below.

Notes:

• In the following sample code, an underscore (_) is used as a line- continuation character. Remove the underscore when re-creating this code in Access Basic.
• You may have some Microsoft Windows API functions defined in an existing Microsoft Access library; therefore, your declarations may be duplicates. If you receive a duplicate procedure name error message, remove or comment out the declarations statement in your code.

Code for the ScreenDump() Function:

   Option Compare Database
   Option Explicit

   Type RECT_Type
       left As Integer
       top As Integer
       right As Integer
       bottom As Integer
   End Type

   Declare Function GetActiveWindow% Lib "User" ()
   Declare Function GetDesktopWindow% Lib "User" ()
   Declare Sub GetWindowRect Lib "User" (ByVal Hwnd%, _
                                       lpRect As RECT_Type)
   Declare Function GetDC% Lib "User" (ByVal Hwnd%)
   Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hdc%)
   Declare Function CreateCompatibleBitmap% Lib "GDI" (ByVal hdc%, _
                                       ByVal nWidth%, ByVal nHeight%)
   Declare Function SelectObject% Lib "GDI" (ByVal hdc%, ByVal hObject%)
   Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal X%, _
                                       ByVal Y%, ByVal nWidth%, _
                                       ByVal nHeight%, ByVal hSrcDC%, _
                                       ByVal XSrc%, ByVal YSrc%, _
                                       ByVal dwRop&)
   Declare Function OpenClipboard% Lib "User" (ByVal Hwnd%)
   Declare Function EmptyClipboard% Lib "User" ()
   Declare Function SetClipboardData% Lib "User" (ByVal wFormat%, _
                                       ByVal hMem%)
   Declare Function CloseClipboard% Lib "User" ()
   Declare Function ReleaseDC% Lib "User" (ByVal Hwnd%, ByVal hdc%)
   Declare Function DeleteDC% Lib "GDI" (ByVal hdc%)

   Global Const SRCCOPY = &HCC0020
   Global Const CF_BITMAP = 2

   Function ScreenDump ()
      Dim AccessHwnd%, DeskHwnd%
      Dim hdc%
      Dim hdcMem%
      Dim rect As RECT_Type
      Dim junk%
      Dim fwidth%, fheight%
      Dim hBitmap%

       DoCmd Hourglass True

       '---------------------------------------------------
       ' Get window handle to Windows and Microsoft Access
       '---------------------------------------------------
       DeskHwnd = GetDesktopWindow()
       AccessHwnd = GetActiveWindow()

       '---------------------------------------------------
       ' Get screen coordinates of Microsoft Access
       '---------------------------------------------------
       Call GetWindowRect(AccessHwnd, rect)
       fwidth = rect.right - rect.left
       fheight = rect.bottom - rect.top

       '---------------------------------------------------
       ' Get the device context of Desktop and allocate memory
       '---------------------------------------------------
       hdc = GetDC(DeskHwnd)
       hdcMem = CreateCompatibleDC(hdc)
       hBitmap = CreateCompatibleBitmap(hdc, fwidth, fheight)

       If hBitmap <> 0 Then
          junk = SelectObject(hdcMem, hBitmap)

          '---------------------------------------------
          ' Copy the Desktop bitmap to memory location
          ' based on Microsoft Access coordinates.
          '---------------------------------------------
          junk = BitBlt(hdcMem, 0, 0, fwidth, fheight, hdc, rect.left, _
                        rect.top, SRCCOPY)

          '---------------------------------------------
          ' Set up the Clipboard and copy bitmap
          '---------------------------------------------
          junk = OpenClipboard(DeskHwnd)
          junk = EmptyClipboard()
          junk = SetClipboardData(CF_BITMAP, hBitmap)
          junk = CloseClipboard()
       End If

       '---------------------------------------------
       ' Clean up handles
       '---------------------------------------------
       junk = DeleteDC(hdcMem)
       junk = ReleaseDC(DeskHwnd, hdc)

       DoCmd Hourglass False

   End Function