PureBasic Forums - English

Posted: **Thu Aug 24, 2006 9:49 pm**

Code updated For 5.20+

so i forgot about the whole mousehook thing, as its a NIGHTMARE to try and do.

i broke down and coded something the old fashioned way. here is a small screenshotter that allows the user to select a screen area with a rectangle, and snap a bitmap. the bitmap is then displayed in an imagegadget.

im tired now, and if anyone can clean up this code to make it more useable for everyone, please do so.

Code: Select all




Global startcapture.l 
Global lastwidth.w,lastheight.w,originalx.w, originaly.w,bitmapcapture.l 

startcapture=0

Procedure DesktopOutput()
  Memory = AllocateMemory(1024)
  PokeL(Memory, 1)
  ProcedureReturn Memory
EndProcedure

Procedure CaptureScreenPart(hwnd,left.l, top.l, Width.l, Height.l)
  dm.DEVMODE
  BMPHandle.l
  srcDC = GetDC_(hwnd) 
  trgDC = CreateCompatibleDC_(srcDC)
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
  SelectObject_( trgDC, BMPHandle)
  BitBlt_( trgDC, 0, 0, Width, Height, srcDC, left, top, #SRCCOPY)
  DeleteDC_( trgDC)
  ReleaseDC_( BMPHandle, srcDC) 
  CaptureScreenHeight=Height
  CaptureScreenWidth=Width
  CaptureScreenBMPHandle=BMPHandle
  ProcedureReturn BMPHandle
EndProcedure 

Procedure CaptureCallback(hwnd, msg,wParam,lParam)
  Select msg
    Case #WM_LBUTTONDOWN
      originalx= lParam&$FFFF 
      originaly = (lParam>>16)&$FFFF
      startcapture=1
      SetCapture_(hwnd) 
    Case #WM_MOUSEMOVE
      If startcapture=1
        MouseOffsetX.w = lParam&$FFFF       - originalx
        MouseOffsetY.w = (lParam>>16) - originaly
        dc=StartDrawing(DesktopOutput())
        DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
        Box(originalx,originaly,lastwidth,lastheight)
        Box(originalx,originaly,MouseOffsetX,MouseOffsetY)
        StopDrawing()
        lastwidth=MouseOffsetX
        lastheight=MouseOffsetY
      EndIf 
    Case #WM_LBUTTONUP 
      dc=StartDrawing(DesktopOutput())
      DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
      Box(originalx,originaly,lastwidth,lastheight)
      StopDrawing()
      SetCursor_(#IDC_ARROW)
      ReleaseCapture_()
      startcapture=0
      upx= lParam&$FFFF 
      upy = (lParam>>16)&$FFFF
      If upx< originalx
        x=upx
        Width=originalx-upx
      Else
        x=originalx
        Width=upx-originalx
      EndIf 
      If upy<originaly
        Y=upy
        Height=originaly-upy
      Else 
        Y=originaly
        Height=upy-originaly
      EndIf 
      
      bitmapcapture=CaptureScreenPart(hwnd,x,Y,Width,Height)
      SendMessage_(GadgetID(0),#STM_SETIMAGE,#IMAGE_BITMAP,bitmapcapture)
      SetClassLong_(hwnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))	
      ShowWindow_(GetParent_(hwnd),#sw_hide)
      HideWindow(0,0)
      DestroyWindow_(GetParent_(hwnd))
      originalx=0
      originaly=0
      lastwidth=0
      lastheight=0
  EndSelect 
  ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure

Procedure startcapture()
  sourcedc=GetDC_(GetDesktopWindow_())
  Screenshotimage= CreateImage(#PB_Any,GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN))
  destdc=StartDrawing(ImageOutput(Screenshotimage))
  BitBlt_(destdc,0,0,GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN),sourcedc,0,0,#SRCCOPY)
  StopDrawing()
  capturewin=OpenWindow(#PB_Any, 0, 0, GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN),"", #WS_POPUP)
  CreateGadgetList(WindowID(capturewin))
  imagegad=ImageGadget(#PB_Any, 0, 0,  GetSystemMetrics_(#SM_CXSCREEN),GetSystemMetrics_(#SM_CYSCREEN), ImageID(Screenshotimage))
  SetProp_(GadgetID(imagegad),"OldProc",SetWindowLong_(GadgetID(imagegad), #GWL_WNDPROC, @CaptureCallback()))
  SetForegroundWindow_(WindowID(capturewin))
  SetClassLong_(GadgetID(imagegad),#GCL_HCURSOR,LoadCursor_(0,#IDC_CROSS))	
EndProcedure 
  

If OpenWindow(0,100,150,341,355,"",#PB_Window_SystemMenu)
  CreateGadgetList(WindowID(0))
  ImageGadget(0,10,10,300,300,0,#PB_Image_Border)
  RegisterHotKey_(WindowID(0),1,#MOD_SHIFT|#MOD_CONTROL,#VK_F11)
  Repeat
    Select WaitWindowEvent()
      Case #WM_HOTKEY
        HideWindow(0,1)
        Delay(200)
        startcapture()
        
      Case #PB_Event_CloseWindow
        End 
    EndSelect
  ForEver
EndIf

Posted: **Fri Aug 25, 2006 8:31 am**

Sweet, look at my versions:

http://www.purebasic.fr/german/viewtopi ... 4113#44113

and with mousecontrol:

http://www.purebasic.fr/german/viewtopi ... 4977#44977

Windows and Linux(with ImageMagick) only.
[EDIT]
I know they are just procedures to do it, not a whole app.

Posted: **Wed Aug 30, 2006 12:43 pm**

@DarkDragon, very nice piece of code, works a treat here. Thanks for sharing it!

PureBasic Forums - English

Screenshooter

Screenshooter