• Welcome to Powerbasic Museum 2020-B.
 

GDI: Capturing an image of the entire screen and displaying it in a dialog

Started by José Roca, August 30, 2008, 04:29:37 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

José Roca

The following example captures an image of the entire screen, creates a compatible device context and a bitmap with the appropriate dimensions, selects the bitmap into the compatible DC, and then copies the image using the BitBlt function. Later, in the WM_PAINT and WM_ERASEBKGND messages, redisplays the image calling BitBlt again, specifying the compatible DC as the source DC and a window DC as the target DC.


' ========================================================================================
' The following example captures an image of the entire screen, creates a compatible
' device context and a bitmap with the appropriate dimensions, selects the bitmap into the
' compatible DC, and then copies the image using the BitBlt function.
' Later, in the WM_PAINT and WM_ERASEBKGND messages, redisplays the image calling BitBlt
' again, specifying the compatible DC as the source DC and a window DC as the target DC.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                  BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

   LOCAL szAppName AS ASCIIZ * 256
   LOCAL uMsg      AS tagMsg
   LOCAL hwnd      AS DWORD
   LOCAL wc        AS WNDCLASS
   LOCAL szCaption AS ASCIIZ * 256

   szAppName        = "BitBltDemo"
   wc.style         = %CS_HREDRAW OR %CS_VREDRAW
   wc.lpfnWndProc   = CODEPTR(WndProc)
   wc.cbClsExtra    = 0
   wc.cbWndExtra    = 0
   wc.hInstance     = hInstance
   wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
   wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wc.lpszMenuName  = VARPTR(szAppName)
   wc.lpszClassName = VARPTR(szAppName)

   IF ISFALSE RegisterClass(wc) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   szCaption = "BitBlt Demo"
   hwnd = CreateWindow (szAppName, _             ' window class name
                        szCaption, _             ' window caption
                        %WS_OVERLAPPEDWINDOW, _  ' window style
                        %CW_USEDEFAULT, _        ' initial x position
                        %CW_USEDEFAULT, _        ' initial y position
                        %CW_USEDEFAULT, _        ' initial x size
                        %CW_USEDEFAULT, _        ' initial y size
                        %NULL, _                 ' parent window handle
                        %NULL, _                 ' window menu handle
                        hInstance, _             ' program instance handle
                        %NULL)                   ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hwnd, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hdcCompatible AS DWORD         ' // Handle of the compatible device context
   STATIC cxBitmap      AS LONG          ' // Width of the bitmap
   STATIC cyBitmap      AS LONG          ' // Height of the bitmap
   LOCAL  hdcScreen     AS DWORD         ' // Desktop device context
   LOCAL  hbmScreen     AS DWORD         ' // Screen bitmap handle
   LOCAL  hdc           AS DWORD         ' // Window device context
   LOCAL  ps            AS PAINTSTRUCT   ' // PAINTSTRUCT structure

   SELECT CASE wMsg

     CASE %WM_CREATE

         ' // Create a normal DC and a memory DC for the entire screen. The
         ' // normal DC provides a "snapshot" of the screen contents. The
         ' // memory DC keeps a copy of this "snapshot" in the associated
         ' // bitmap.
         hdcScreen = CreateDC("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         hdcCompatible = CreateCompatibleDC(hdcScreen)

         ' // Create a compatible bitmap for hdcScreen.
         cxBitmap = GetDeviceCaps(hdcScreen, %HORZRES)
         cyBitmap = GetDeviceCaps(hdcScreen, %VERTRES)
         hbmScreen = CreateCompatibleBitmap(hdcScreen, cxBitmap, cyBitmap)

         ' // Select the bitmaps into the compatible DC.
         SelectObject(hdcCompatible, hbmScreen)
         ' // Copy color data for the entire display into a
         ' // the bitmap that is selected into a compatible DC.
         BitBlt hdcCompatible, 0, 0, cxBitmap, cyBitmap, hdcScreen, 0, 0, %SRCCOPY
         ' // Delete the screen DC and bitmap
         DeleteDC hdcScreen
         DeleteObject hbmScreen
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         BitBlt hdc, 0, 0, cxBitmap, cyBitmap, hdcCompatible, 0, 0, %SRCCOPY
         EndPaint hwnd, ps
         EXIT FUNCTION

      CASE %WM_ERASEBKGND
         hdc = wParam
         BitBlt hdc, 0, 0, cxBitmap, cyBitmap, hdcCompatible, 0, 0, %SRCCOPY
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_DESTROY
         IF hdcCompatible THEN DeleteDC hdcCompatible
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

 
The following example captures an image of the entire screen, creates a compatible device context and a bitmap with the appropriate dimensions, selects the bitmap into the compatible DC, and then copies the image using the BitBlt function. Later, in the WM_PAINT and WM_ERASEBKGND messages, redisplays the image calling StretchBlt, specifying the compatible DC as the source DC and a window DC as the target DC. To get better image quality, the stretching mode is set to HALFTONE.


' ========================================================================================
' The following example captures an image of the entire screen, creates a compatible
' device context and a bitmap with the appropriate dimensions, selects the bitmap into the
' compatible DC, and then copies the image using the BitBlt function.
' Later, in the WM_PAINT and WM_ERASEBKGND messages, redisplays the image calling StretchBlt,
' specifying the compatible DC as the source DC and a window DC as the target DC.
' To get better image quality, the stretching mode is set to HALFTONE.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                  BYVAL pszCmdLine AS ASCIIZ PTR, BYVAL iCmdShow AS LONG) AS LONG

   LOCAL szAppName AS ASCIIZ * 256
   LOCAL uMsg      AS tagMsg
   LOCAL hwnd      AS DWORD
   LOCAL wc        AS WNDCLASS
   LOCAL szCaption AS ASCIIZ * 256

   szAppName        = "StretchBltDemo"
   wc.style         = %CS_HREDRAW OR %CS_VREDRAW
   wc.lpfnWndProc   = CODEPTR(WndProc)
   wc.cbClsExtra    = 0
   wc.cbWndExtra    = 0
   wc.hInstance     = hInstance
   wc.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
   wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
   wc.lpszMenuName  = VARPTR(szAppName)
   wc.lpszClassName = VARPTR(szAppName)

   IF ISFALSE RegisterClass(wc) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   szCaption = "StretchBlt Demo"
   hwnd = CreateWindow (szAppName, _             ' window class name
                        szCaption, _             ' window caption
                        %WS_OVERLAPPEDWINDOW, _  ' window style
                        %CW_USEDEFAULT, _        ' initial x position
                        %CW_USEDEFAULT, _        ' initial y position
                        %CW_USEDEFAULT, _        ' initial x size
                        %CW_USEDEFAULT, _        ' initial y size
                        %NULL, _                 ' parent window handle
                        %NULL, _                 ' window menu handle
                        hInstance, _             ' program instance handle
                        %NULL)                   ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hwnd, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hdcCompatible AS DWORD         ' // Handle of the compatible device context
   STATIC cxBitmap      AS LONG          ' // Width of the bitmap
   STATIC cyBitmap      AS LONG          ' // Height of the bitmap
   STATIC cxClient      AS LONG          ' // Width of the client area
   STATIC cyClient      AS LONG          ' // Height of the client area
   LOCAL  hdcScreen     AS DWORD         ' // Desktop device context
   LOCAL  hbmScreen     AS DWORD         ' // Screen bitmap handle
   LOCAL  hdc           AS DWORD         ' // Window device context
   LOCAL  ps            AS PAINTSTRUCT   ' // PAINTSTRUCT structure

   SELECT CASE wMsg

     CASE %WM_CREATE

         ' // Create a normal DC and a memory DC for the entire screen. The
         ' // normal DC provides a "snapshot" of the screen contents. The
         ' // memory DC keeps a copy of this "snapshot" in the associated
         ' // bitmap.
         hdcScreen = CreateDC("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         hdcCompatible = CreateCompatibleDC(hdcScreen)

         ' // Create a compatible bitmap for hdcScreen.
         cxBitmap = GetDeviceCaps(hdcScreen, %HORZRES)
         cyBitmap = GetDeviceCaps(hdcScreen, %VERTRES)
         hbmScreen = CreateCompatibleBitmap(hdcScreen, cxBitmap, cyBitmap)

         ' // Select the bitmaps into the compatible DC.
         SelectObject(hdcCompatible, hbmScreen)
         ' // Copy color data for the entire display into a
         ' // the bitmap that is selected into a compatible DC.
         BitBlt hdcCompatible, 0, 0, cxBitmap, cyBitmap, hdcScreen, 0, 0, %SRCCOPY
         ' // Delete the screen DC and bitmap
         DeleteDC hdcScreen
         DeleteObject hbmScreen
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
               IF HIWRD(wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

     CASE %WM_SIZE
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)
         FUNCTION = 0
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetStretchBltMode hdc, %HALFTONE
         SetBrushOrgEx hdc, 0, 0, BYVAL %NULL
         StretchBlt hdc, 0, 0, cxClient, cyClient, _
                    hdcCompatible, 0, 0, cxBitmap, cyBitmap, %SRCCOPY
         EndPaint hwnd, ps

      CASE %WM_ERASEBKGND
         hdc = wParam
         SetStretchBltMode hdc, %HALFTONE
         SetBrushOrgEx hdc, 0, 0, BYVAL %NULL
         StretchBlt hdc, 0, 0, cxClient, cyClient, _
                    hdcCompatible, 0, 0, cxBitmap, cyBitmap, %SRCCOPY
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_DESTROY
         IF hdcCompatible THEN DeleteDC hdcCompatible
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


Edwin Knoppert

Haha, neat (not tested).

I used GetDeskTopWindow() used the screen DC.
CreateDC(DISPLAY) already having the snapshot, who could  imagne :)

Patrice Terrier

From the AEROGLASS GDImage demo  ;)


SUB ScreenCaptureToBackground()
    LOCAL SysXRes AS LONG, SysYRes AS LONG, gCtrl AS LONG, hDeskTop AS LONG, hDCSrce AS LONG
    SysXRes = GetSystemMetrics(%SM_CXSCREEN)
    SysYRes = GetSystemMetrics(%SM_CYSCREEN)
    gCtrl = GetDlgItem(hMain, %ID_CTRL)
    CALL ZI_CreateImageBackground(gCtrl, SysXRes, SysYRes)
    hDeskTop = GetDesktopWindow(): hDCSrce = GetWindowDC(hDeskTop)
    CALL BitBlt(ZI_GetDC(gCtrl), 0, 0, SysXRes, SysYRes, hDCSrce, 0, 0, %SRCCOPY)
    CALL ReleaseDC(hDeskTop, hDCSrce)
END SUB
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Theo Gottwald

The first two seem to have problems with multi-monitor (DUAL-Screen).
They only copy my left (1.st) Screen.

Edwin Knoppert

Ha, that may be a thing to explore.
Not sure how to deal with that.
I guess the monitor functions provide a DC as well.