Code: Select all
;*************************************************************
;I needed to capture images (or parts of) from the screen quickly and invisibly
;incorporating them into an application.
;I could find nothing suitable, although I must admit I didn’t look that hard as there is
;nothing like having control of your own code.
;I looked at the Windows API and tinkered with SetCapture etc. but it’s a long time
;since I did any of that stuff so I decided on a (mostly) Pure PB solution.
;I am no doubt reinventing the wheel (maybe even for this site) but the following I
;hope is very easy to understand and adapt if useful.
;I would be interested in other solutions.
;Mike
;*************************************************************
EnableExplicit
Global screenwidth,screenheight
Global win,canvas
Global mousedown,screenimage
Global x,y,w,d
Procedure capturescreen() ;Courtesy of this forum
Define dc,h
screenimage=CreateImage(#PB_Any,screenwidth,screenheight)
dc=GetDC_(GetDesktopWindow_())
h=StartDrawing(ImageOutput(screenimage))
BitBlt_(h,0,0,DesktopWidth(0),DesktopHeight(0),dc,0,0,#SRCCOPY)
StopDrawing()
ReleaseDC_(GetDesktopWindow_(),dc)
EndProcedure
Procedure showghostscreen()
StartDrawing(CanvasOutput(canvas))
DrawAlphaImage(ImageID(screenimage),0,0,180)
StopDrawing()
EndProcedure
Procedure dosomething(newimage)
;Do what you like with the captured image
;Below displays the image and puts it in the clipboard
Define centerx=screenwidth/2-w/2
Define centery=screenheight/2-d/2
StartDrawing(CanvasOutput(canvas))
DrawingMode(#PB_2DDrawing_Outlined)
Box(centerx-1,centery-1,w+2,d+2,#Black)
DrawImage(ImageID(newimage),centerx,centery)
StopDrawing()
Repeat
WaitWindowEvent()
Select EventType()
Case #PB_EventType_LeftButtonUp,#PB_EventType_Input,
#PB_EventType_KeyDown,#PB_EventType_RightButtonDown
Break
EndSelect
ForEver
SetClipboardImage(newimage)
EndProcedure
Procedure startdrag()
If Not mousedown
x=GetGadgetAttribute(canvas,#PB_Canvas_MouseX)
y=GetGadgetAttribute(canvas,#PB_Canvas_MouseY)
mousedown=1
EndIf
EndProcedure
Procedure dodrag()
If mousedown
StartDrawing(CanvasOutput(canvas))
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Box(x,y,w,d)
w=GetGadgetAttribute(canvas,#PB_Canvas_MouseX)-x
d=GetGadgetAttribute(canvas,#PB_Canvas_MouseY)-y
Box(x,y,w,d)
StopDrawing()
EndIf
EndProcedure
Procedure stopdrag()
Define newimage
If w>10 And d>10 ;Ignore silly sized images
newimage=GrabImage(screenimage,#PB_Any,x,y,w,d)
dosomething(newimage)
EndIf
EndProcedure
Procedure imagecapture()
ExamineDesktops()
screenwidth=DesktopWidth(0)
screenheight=DesktopHeight(0)
capturescreen()
win=OpenWindow(#PB_Any,0,0,screenwidth,screenheight,"",
#PB_Window_BorderLess|#PB_Window_Invisible)
canvas=CanvasGadget(#PB_Any,0,0,screenwidth,screenheight,#PB_Canvas_Keyboard)
showghostscreen()
SetActiveGadget(canvas)
HideWindow(win,0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventType()
Case #PB_EventType_LeftButtonDown : startdrag()
Case #PB_EventType_MouseMove : dodrag()
Case #PB_EventType_LeftButtonUp : stopdrag() : Break
Case #PB_EventType_Input,#PB_EventType_KeyDown,#PB_EventType_RightButtonDown : Break
EndSelect
EndSelect
ForEver
EndProcedure
imagecapture()