Screen Capture III

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE  "gbSnapper.exe"
#Dim All
%Unicode=1
#Include "Win32api.inc"
%IDC_Graphic = 500
Global hBMP, hMEMOld, hMEMDC, hBMPDC, hGraphicDC, hDlg, hScreen, hCapture, hScreenDC, hDesktopDC As Dword
Global pt, ptDrawOrig As Point
Global DrawInWork As Long
 
Function PBMain() As Long
   Local w,h As Long
   Desktop Get Size To w,h
   Dialog New Pixels, 0, "",0,0,w,h, %WS_Popup, %WS_EX_TOPMOST To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic, "", 0,0,w,h, %WS_CHILD OR %WS_VISIBLE OR %SS_OWNERDRAW
   Dialog Show Modal hDlg Call DlgProc
End Function
 
Sub CopyScreenToMemoryBitmap
   Local w,h as Long
   Desktop Get Size To w,h
   hDeskTopDC = GetDC(%Null)
   hMemDC = CreateCompatibleDC(hDeskTopDC)            'memory DC
   hBMP = CreateCompatibleBitmap(hDeskTopDC, w,h)     'memory bitmap
   hMemOld = SelectObject(hMemDC, hBMP)               'select bitmap into memory DC
   BitBlt hGraphicDC, 0,0,w,h, hMemDC, 0,0, %SRCCopy 'copy memory DC to Grpahic Control DC
   hBMP = SelectObject(hMemDC, hMemOld)         'unselect bitmap out of memory dc
   hBMPDC = GetDC(hBMP)
   ReleaseDC(%Null, hDeskTopDC)
End Sub
 
CallBack Function DlgProc() As Long
   Local w,h,iReturn As Long, fName As Asciiz * %Max_Path
   Select Case Cb.Msg
      Case %WM_InitDialog
         CopyScreenToMemoryBitmap     'create memory bitmap and copy image of screen to it for later use
         Graphic Attach hDlg, %IDC_Graphic, Redraw
         Graphic Get DC To hGraphicDC
         BitBlt hGraphicDC, 0,0,w,h, hBMPDC, 0,0, %SRCCopy 'copy memory DC to Grpahic Control DC
 
      Case %WM_Destroy
         'message (optional)
         w = Abs(ptDrawOrig.x - pt.x) + 1 : h = Abs(ptDrawOrig.y - pt.y) + 1
         MsgBox "Selection placed on clipboard." + $crlf + "Size: " + str$(w) + " x" + str$(h), %MB_Ok or %MB_IconInformation, "gbSnapper"
         'put captured image into memory bitmap
         Graphic Bitmap New w,h To hCapture : Graphic Attach hCapture,0
         Graphic Copy hScreen, 0, (ptDrawOrig.x,ptDrawOrig.y)-(pt.x,pt.y) To (0,0)
         'copy to clipboard (optional)
         Clipboard Reset : Clipboard Set Bitmap hCapture
         'save to file (optional)
         fName = Exe.path$ + "gbsnapper.bmp"
         Graphic Save fName    'save to file
         'display saved file in default imageview (optonal)
         iReturn = ShellExecute(hDlg, "Open", fName, $Nul, $Nul, %SW_ShowNormal)  'open
      Case %WM_MouseMove
         MousePtr 2 : Function = 1     'maintain cross hairs
      Case %WM_SetCursor
         Dialog Get Client hDlg To w,h : GetCursorPos pt : ScreenToClient hDlg, pt  'get mouse position in dialog coordinates
         Select Case Hi(Word, Cb.LParam)
            Case %WM_LButtonDown
               DrawInWork = 1 : ptDrawOrig = pt  'start drawing line
            Case %WM_MouseMove
               If DrawInWork Then
                  Graphic Copy hScreen, 0     'put screen image in graphic control
                  Graphic Box (ptDrawOrig.x, ptDrawOrig.y) - (pt.x, pt.y),, %Red   'draw rectangle that follows the mouse
                  Graphic Redraw
               End If
            Case %WM_LButtonUp   : Dialog End hDlg   'exit when left mouse button is released
         End Select
   End Select
End Function
 
'gbs_00934
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm