Screen Capture II

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 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
   Graphic Bitmap New w,h To hScreen
   hDeskTopDC = GetDC(%Null)
   Graphic Attach hScreen,0, ReDraw
   Graphic Get DC To hScreenDC
   BitBlt hScreenDC, 0,0,w,h, hDeskTopDC, 0,0, %SRCCopy 'copy desktop image to
   ReleaseDC(%Null,hDeskTopDC)
   Graphic ReDraw
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 Copy hScreen,0
      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_00708
'Date: 03-10-2012

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