Fully functional Screen Capture (like SnagIt)

Share your advanced PureBasic knowledge/code with the community.
Post Reply
cecilcheah
Enthusiast
Enthusiast
Posts: 168
Joined: Wed Jun 04, 2003 8:44 am
Location: Switzerland

Fully functional Screen Capture (like SnagIt)

Post by cecilcheah »

With the help of those nice people here, i am able to make this screen capture the way it is like in SnagIt.

Feature:
Left mouse down to start cpature
Drag while left mouse is still down to define a rectangle to capture.
Left mouse up to finish capture
Hotkey (Shift + Ctrl + F11) to start capture.

When the capture start, it will sit there until someone press the hot keys and then you should start the capturing process. The captured image will be in the clipboard.

Thanks again to all who help.

Cecil

Code: Select all

;Drag with left mouse button to select a part of the screen 
;Release the left button to paste it as a bitmap to the clipboard and end 

Window_Width  = GetSystemMetrics_(#SM_CXSCREEN) 
Window_Height = GetSystemMetrics_(#SM_CYSCREEN) 

corner1.POINT 
corner2.POINT 

Procedure CaptureScreen(Left, Top, Width, Height) 
  dm.DEVMODE ;structure for CreateDC() 
  srcDC.l 
  trgDC.l 
  BMPHandle.l 
  srcDC = CreateDC_("DISPLAY", "", "", dm) 
  trgDC = CreateCompatibleDC_(srcDC) 
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height) 
  SelectObject_(trgDC, BMPHandle) 
  BitBlt_(trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY) 
  OpenClipboard_(#NULL) 
  EmptyClipboard_() 
  SetClipboardData_(2, BMPHandle) 
  CloseClipboard_() 
  DeleteDC_(trgDC) 
  ReleaseDC_(BMPHandle, srcDC) 
  
  
  MyImage = CreateImage(0, width, height) ; create a new empty bitmap, retrieve handle 
ImageID = GetClipboardData(#PB_ClipboardImage) ; get clipboard bitmap handle 
StartDrawing(ImageOutput()) ; start drawing to the bitmap we created 
DrawImage(ImageID, 0, 0) ; draw the image from clipboard 
DrawingMode(0)
Locate(0, height/2)
FrontColor(255,0,0)
BackColor(0,0,0)
  DrawText("Some text.") ; I am making some shareware, so i add some text so people must register.
StopDrawing() 
SetClipboardData(#PB_ClipboardImage, MyImage)

  
ProcedureReturn 
EndProcedure 

CatchImage(2, ?Logo)

If OpenWindow(0,100,150,291,155,#PB_Window_SystemMenu,"TBK Capture") 
  CreateGadgetList(WindowID()) 
  ImageGadget(0, 0, 0, 0, 0, UseImage(2))
  RegisterHotKey_(WindowID(),1,#MOD_SHIFT|#MOD_CONTROL,#VK_F11) 
  Repeat 
    Select WindowEvent() 

    Case #WM_HOTKEY
      Pic_desktop = CreateImage(1, Window_Width, Window_Height) 

      hDC = StartDrawing(ImageOutput()) 
  
      BitBlt_(hDC, 0, 0, Window_Width, Window_Height, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 

      StopDrawing() 

      OpenWindow(1, 0, 0, Window_Width, Window_Height, #WS_POPUP, "Capturing") 
      CreateGadgetList(WindowID()) 
      ImageGadget(1, 0, 0,  Window_Width, Window_Height, Pic_desktop) 
      Layer1_desktop = CreateImage(2, Window_Width, Window_Height) 
      
      hWnd1 = FindWindow_(0, "Capturing")
      SetForegroundWindow_(hWnd1)
        
    Case #WM_MOUSEMOVE 
      If drawbox And SettingCursor=0 
        UseImage(2) 
        StartDrawing(WindowOutput()) 
          DrawImage(UseImage(1), 0, 0)      
          FrontColor(255, 255, 255) 
          DrawingMode(2|4) 
          GetCursorPos_(corner2) 
          Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
        StopDrawing() 
        SettingCursor = 1 
        SetCursorPos_(corner2\x, corner2\y) 
      Else 
        SettingCursor = 0 
      EndIf 
    Case #WM_LBUTTONDOWN 
      GetCursorPos_(corner1) 
      drawbox = 1 
    Case #WM_LBUTTONUP 
      StartDrawing(WindowOutput()) ; don't grab the boxlines 
        DrawImage(UseImage(1),0,0)                    
        StopDrawing() 
        ;CreateCompatibleBitmap_ cannot handle negative width/height values... 
        If corner1\x>corner2\x:temp = corner2\x:corner2\x = corner1\x:corner1\x = temp:EndIf 
        If corner1\y>corner2\y:temp = corner2\y:corner2\y = corner1\y:corner1\y = temp:EndIf 
        CaptureScreen(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y) 
        MessageRequester("", "Copied to clipboard...", #MB_ICONINFORMATION) 
        End 
        drawbox = 0
      
      

;    Case #WM_LBUTTONUP:drawbox = 0 
  EndSelect 
  Delay(1) 
  ForEver 
EndIf

Logo: IncludeBinary "FOO.bmp"
End
[/code]
Top
aucrobert
New User
New User
Posts: 4
Joined: Tue Nov 18, 2014 8:31 pm

Re: Fully functional Screen Capture (like SnagIt)

Post by aucrobert »

It look a nice prg. but nothing work anymore I try
to find the version it was program it look 2003
-----------
Some one knows a PRG to screen capture send to clipboard
best in mac format or pc no problem.
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Fully functional Screen Capture (like SnagIt)

Post by netmaestro »

Many key libraries have changed since this code was posted. I don't have time to write a complete program for something like this but I can spare a few minutes to update this 12-year-old code to be compatible with the latest version of PureBasic. I tested and it seems to work as advertised:

Code: Select all

; Run the prog
; Press CTRL-SHIFT-F11
; Drag with left mouse button to select a part of the screen 
; Release the left button to paste it as a bitmap to the clipboard and end 

Window_Width  = GetSystemMetrics_(#SM_CXSCREEN) 
Window_Height = GetSystemMetrics_(#SM_CYSCREEN) 

corner1.POINT 
corner2.POINT 

Procedure CaptureScreen(Left, Top, Width, Height) 
  
  dm.DEVMODE ;structure for CreateDC() 
  srcDC.l 
  trgDC.l 
  BMPHandle.l 
  srcDC = CreateDC_("DISPLAY", "", "", dm) 
  trgDC = CreateCompatibleDC_(srcDC) 
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height) 
  SelectObject_(trgDC, BMPHandle) 
  BitBlt_(trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY) 
  OpenClipboard_(#Null) 
  EmptyClipboard_() 
  SetClipboardData_(2, BMPHandle) 
  CloseClipboard_() 
  DeleteDC_(trgDC) 
  ReleaseDC_(BMPHandle, srcDC) 
  
  MyImage = CreateImage(0, width, height)        ; create a new empty bitmap, retrieve handle 
  StartDrawing(ImageOutput(0))             ; start drawing to the bitmap we created 
    DrawImage(BMPHandle, 0, 0)                     ; draw the image from clipboard 
    FrontColor(RGB(255,0,0))
    BackColor(RGB(0,0,0))
    DrawText(0, height/2, "Some text.") ; I am making some shareware, so i add some text so people must register.
  StopDrawing() 
  SetClipboardImage(0)
  
  ProcedureReturn 
EndProcedure 

CatchImage(2, ?Logo)

If OpenWindow(0,100,150,291,155,"TBK Capture",#PB_Window_SystemMenu) 
  
  ImageGadget(0, 0, 0, 0, 0, ImageID(2))
  RegisterHotKey_(WindowID(0),1,#MOD_SHIFT|#MOD_CONTROL,#VK_F11) 
  Repeat 
    Select WaitWindowEvent(1) 
        
      Case #WM_HOTKEY
        Pic_desktop = CreateImage(1, Window_Width, Window_Height) 
        HideWindow(0,1)
        Delay(250)
        hDC = StartDrawing(ImageOutput(1)) 
          BitBlt_(hDC, 0, 0, Window_Width, Window_Height, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 
        StopDrawing() 
        OpenWindow(1, 0, 0, Window_Width, Window_Height, "Capturing", #PB_Window_BorderLess) 
        StickyWindow(1,1)
        ImageGadget(1, 0, 0,  Window_Width, Window_Height, Pic_desktop)  
        hWnd1 = FindWindow_(0, "Capturing")
        SetForegroundWindow_(hWnd1)
        
      Case #WM_MOUSEMOVE 
        If drawbox And SettingCursor=0 
          StartDrawing(WindowOutput(1)) 
            DrawImage(ImageID(1), 0, 0)      
            FrontColor(#White) 
            DrawingMode(#PB_2DDrawing_XOr|#PB_2DDrawing_Outlined) 
            GetCursorPos_(corner2) 
            Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
          StopDrawing() 
          SettingCursor = 1 
          SetCursorPos_(corner2\x, corner2\y) 
        Else 
          SettingCursor = 0 
        EndIf 
        
      Case #WM_LBUTTONDOWN 
        GetCursorPos_(corner1) 
        drawbox = 1 
        
      Case #WM_LBUTTONUP 
        SetGadgetState(1, ImageID(1))
        ;CreateCompatibleBitmap_ cannot handle negative width/height values... 
        If corner1\x>corner2\x:temp = corner2\x:corner2\x = corner1\x:corner1\x = temp:EndIf 
        If corner1\y>corner2\y:temp = corner2\y:corner2\y = corner1\y:corner1\y = temp:EndIf 
        CaptureScreen(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y) 
        MessageRequester("", "Copied to clipboard...", #MB_ICONINFORMATION) 
        End 
        
      Case #PB_Event_CloseWindow
        Break

    EndSelect 
 
  ForEver 
EndIf

DataSection
  logo:
  IncludeBinary #PB_Compiler_Home+"examples\sources\data\purebasiclogo.bmp"
EndDataSection
BERESHEIT
Top
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Fully functional Screen Capture (like SnagIt)

Post by kvitaliy »

Necessary for BitBlt to get layered windows if present on screen

#CAPTUREBLT = $40000000

Corresponding changes to the code:

Code: Select all

 BitBlt_(hDC, 0, 0, Window_Width, Window_Height, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY|#CAPTUREBLT)
Top
Post Reply

Return to “Tricks 'n' Tips”