what a nightmare figuring all this out was. this version gives you the ability to capture a fixed rectangle, a user-defined section, or capture a full window.
NOTEZ: to capture a window, click on the imagegadget that has a border, and while holding the left mouse button down, drag the mouse around until you have the window you want highlighted.
or use the hotkeys for the other two types.
i commented the part of the code that follows and highlights the full window selection. this was a COMPLETE hell on earth for 2 days.
THIS DOES NOT RESIZE IMAGES CAPTURED.
this is a unclean, unoptimized, way to do what many people have asked for.
once you understand what is going on, you can optimize it, clean it, and tweak it to your needs.
IF ANYONE CAN REALLY CLEAN THIS UP PLEASE LET ME KNOW.
you CAN use the code and my ideas in freeware or commercial appz. but of you do clean it up, post a snippet that is more optimized than this. and give me propz somewhere.
Code: Select all
#WM_MOUSEHOVER = $2A1
#WM_MOUSELEAVE = $2A3
#TME_HOVER = 1
#TME_LEAVE = 2
#cap_rectangle=#WM_USER+1
#cap_any=#WM_USER+2
#cap_ellipse=#WM_USER+3
Global startcapture.l
Global pthwnd.l
Global lastwidth.w,lastheight.w,originalx.w, originaly.w,bitmapcapture.l,MouseBtnDownX,MouseBtnDownY,lbuttondown.l,lasthwnd.l,startsearching.l
Global rct.RECT ,lastx, lasty
startcapture=0
Procedure RegisterBitmap(ImageNumber, hbitmap)
Protected *lptr.LONG, *wptr.WORD, BitmapData.BITMAP
GetObject_(hbitmap, SizeOf(BITMAP), @BitmapData)
CreateImage(ImageNumber, 10, 10)
DeleteObject_(ImageID(ImageNumber))
!EXTRN _PB_Image_CurrentObject
!MOV Eax, [_PB_Image_CurrentObject]
!MOV [p.p_Bitmap], Eax
;!MOV [Esp+8], Eax
*lptr\l = hbitmap
*wptr = *lptr + 4
*wptr\w = BitmapData\bmWidth
*wptr + 2
*wptr\w = BitmapData\bmHeight
*wptr + 2
*wptr\w = BitmapData\bmBitsPixel
*lptr = *wptr + 2
*lptr\l = BitmapData\bmBits
EndProcedure
Procedure MakeLong(lo.w, hi.w)
ProcedureReturn (hi * $10000) | (lo & $FFFF)
EndProcedure
Procedure DesktopOutput()
Memory = AllocateMemory(1024)
PokeL(Memory, 1)
ProcedureReturn Memory
EndProcedure
Procedure CaptureTransparent(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)
GetObject_(BMPHandle,SizeOf(BITMAP),BM.BITMAP)
BMPHandle = CopyImage_(BMPHandle,#IMAGE_BITMAP,BM\bmWidth,BM\bmHeight,0)
ImageList = ImageList_Create_(BM\bmWidth,BM\bmHeight,#ILC_COLORDDB|#ILC_MASK,1,0)
ImageList_AddMasked_(ImageList,ImageID,#COLOR_BTNFACE)
ImageList_Draw_(ImageList,0,trgDC,0,0,#ILD_TRANSPARENT)
ImageList_Destroy_(ImageList)
DeleteDC_( trgDC)
ReleaseDC_( BMPHandle, srcDC)
ProcedureReturn BMPHandle
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)
ProcedureReturn BMPHandle
EndProcedure
Procedure wincapcallback(hwnd, msg,wParam,lParam)
Select msg
Case #WM_MOUSEMOVE
If lbuttondown=1
SetCapture_(hwnd)
GetCursorPos_(lp.POINT)
pthwnd=WindowFromPoint_((lp\x & $FFFFFFFF) | (lp\Y << 32))
If pthwnd=lasthwnd
GetWindowRect_(pthwnd, rct.RECT);
;Get the window dc of the found window.
hWindowDC = GetWindowDC_(pthwnd); this returns WHOLE window dc, including titlebars and nonclient
If hWindowDC
;Select our created pen into the dc And backup the previous pen.
hpen=CreatePen_(#PS_DASH,1,GetSysColor_(#Red))
hPrevPen = SelectObject_(hWindowDC, hpen);
;Select a transparent brush into the dc And backup the previous brush.
hPrevBrush = SelectObject_(hWindowDC, GetStockObject_(#HOLLOW_BRUSH));
;Draw a rectangle in the dc covering the entire window area of the found window.
Rectangle_(hWindowDC, 0, 0, rct\right - rct\left, rct\bottom - rct\top)
;Reinsert the previous pen And brush into the found window's DC.
SelectObject_(hWindowDC, hPrevPen);
SelectObject_(hWindowDC, hPrevBrush);
;Finally release the dc.
ReleaseDC_(pthwnd, hWindowDC);
EndIf
;leave window alone, we are already inside it
ElseIf pthwnd<>lasthwnd
parent=GetParent_(lasthwnd)
If parent ; this is to really cleanup window drawings by refreshing the WHOLE parent
InvalidateRect_(parent, #Null, #True)
UpdateWindow_(parent)
RedrawWindow_(parent, #Null, #Null, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW | #RDW_ERASENOW | #RDW_ALLCHILDREN)
Else ;dont want to skip refreshing a top-pevel window with no parent
InvalidateRect_(lasthwnd, #Null, #True)
UpdateWindow_(lasthwnd)
RedrawWindow_(lasthwnd, #Null, #Null, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW | #RDW_ERASENOW | #RDW_ALLCHILDREN)
EndIf
lasthwnd=pthwnd
GetWindowRect_(pthwnd, rct.RECT);
;Get the window dc of the found window.
hWindowDC = GetWindowDC_(pthwnd); this returns WHOLE window dc, including titlebars and nonclient
If hWindowDC
;Select our created pen into the dc And backup the previous pen.
hpen=CreatePen_(#PS_DASH,1,GetSysColor_(#Red))
hPrevPen = SelectObject_(hWindowDC, hpen);
;Select a transparent brush into the dc And backup the previous brush.
hPrevBrush = SelectObject_(hWindowDC, GetStockObject_(#HOLLOW_BRUSH));
;Draw a rectangle in the dc covering the entire window area of the found window.
Rectangle_(hWindowDC, 0, 0, rct\right - rct\left, rct\bottom - rct\top)
;Reinsert the previous pen And brush into the found window's DC.
SelectObject_(hWindowDC, hPrevPen);
SelectObject_(hWindowDC, hPrevBrush);
;Finally release the dc.
ReleaseDC_(pthwnd, hWindowDC);
EndIf
EndIf
EndIf
ProcedureReturn 0
Case #WM_MOUSELEAVE
Case #WM_LBUTTONDOWN
Delay(100)
lbuttondown=1
SetCapture_(hwnd)
ShowWindow_(GetParent_(hwnd),#SW_HIDE)
Case#WM_LBUTTONUP
lbuttondown=0
InvalidateRect_(lasthwnd, #Null, #True)
UpdateWindow_(lasthwnd);
RedrawWindow_(lasthwnd, #Null, #Null,#RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW | #RDW_ERASENOW | #RDW_ALLCHILDREN)
WindowSize.RECT
GetWindowRect_(pthwnd, WindowSize.RECT)
sbitmap=CaptureScreenPart(GetDesktopWindow_(),WindowSize\left,WindowSize\top,WindowSize\right-WindowSize\left,WindowSize\bottom-WindowSize\top)
ShowWindow_(GetParent_(hwnd),#SW_SHOW)
SendMessage_(GadgetID(0),#STM_SETIMAGE,#IMAGE_BITMAP,sbitmap)
pthwnd=0
lasthwnd=0
ReleaseCapture_()
EndSelect
ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure
Procedure CaptureCallback(hwnd, msg,wParam,lParam)
Select msg
Case #WM_LBUTTONDOWN
type=GetWindowLong_(hwnd, #GWL_USERDATA)
Select type
Case #cap_any
originalx= lParam&$FFFF
originaly = (lParam>>16)&$FFFF
Case #cap_rectangle
MouseBtnDownX = lParam&$FFFF
MouseBtnDownY = (lParam>>16)&$FFFF
rectwidth=100
rectheight=100
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Box(MouseBtnDownX,MouseBtnDownY,rectwidth,rectheight)
StopDrawing()
DeleteObject_(hpen)
Case #cap_ellipse
MouseBtnDownX = lParam&$FFFF
MouseBtnDownY = (lParam>>16)&$FFFF
originalx= lParam&$FFFF
originaly = (lParam>>16)&$FFFF
EndSelect
startcapture=1
SetCapture_(hwnd)
Case #WM_MOUSEMOVE
type=GetWindowLong_(hwnd, #GWL_USERDATA)
Select type
Case #cap_rectangle
If startcapture=1
rectwidth=100
rectheight=100
MouseOffsetX.w = lParam&$FFFF - MouseBtnDownX
MouseOffsetY.w = (lParam>>16) - MouseBtnDownY
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Box(MouseBtnDownX,MouseBtnDownY,rectwidth,rectheight)
MouseBtnDownX + MouseOffsetX
MouseBtnDownY + MouseOffsetY
Box(MouseBtnDownX,MouseBtnDownY,rectwidth,rectheight)
StopDrawing()
DeleteObject_(hpen)
EndIf
Case #cap_any
If startcapture=1
MouseOffsetX.w = lParam&$FFFF - originalx
MouseOffsetY.w = (lParam>>16) - originaly
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Box(originalx,originaly,lastwidth,lastheight)
Box(originalx,originaly,MouseOffsetX,MouseOffsetY)
StopDrawing()
lastwidth=MouseOffsetX
lastheight=MouseOffsetY
DeleteObject_(hpen)
EndIf
Case #cap_ellipse
If startcapture=1
MouseOffsetX.w = lParam&$FFFF - originalx
MouseOffsetY.w = (lParam>>16) - originaly
dc=StartDrawing(DesktopOutput())
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Ellipse(lastx,lasty,lastwidth,lastheight)
Ellipse(lParam&$FFFF,(lParam>>16),MouseOffsetX,MouseOffsetY)
StopDrawing()
lastwidth=MouseOffsetX
lastheight=MouseOffsetY
lastx=lParam&$FFFF
lasty=(lParam>>16)
DeleteObject_(hpen)
EndIf
EndSelect
Case #WM_LBUTTONUP
type=GetWindowLong_(hwnd, #GWL_USERDATA)
Select type
Case #cap_any
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
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
DeleteObject_(hpen)
Case #cap_rectangle
upx= lParam&$FFFF
upy = (lParam>>16)&$FFFF
rectwidth=100
rectheight=100
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Box(upx,upy,rectwidth,rectheight)
StopDrawing()
rectwidth=100
rectheight=100
bitmapcapture=CaptureScreenPart(hwnd,upx,upy,rectwidth,rectheight)
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))
MouseBtnDownX=0
MouseBtnDownY=0
startcapture=0
DeleteObject_(hpen)
Case #cap_ellipse
upx= lParam&$FFFF
upy = (lParam>>16)&$FFFF
MouseOffsetX.w = lParam&$FFFF - originalx
MouseOffsetY.w = (lParam>>16) - originaly
hpen=CreatePen_(#PS_DASH,2,GetSysColor_(#Red))
dc=StartDrawing(DesktopOutput())
SelectObject_(dc,hpen)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_XOr)
Ellipse(upx,upy,MouseOffsetX,MouseOffsetY)
StopDrawing()
region=CreateEllipticRgn_(originalx,originaly,originalx+(2*MouseOffsetX),originaly+(2*MouseOffsetY))
If region
GetRgnBox_(region,box.RECT)
SetWindowRgn_(hwnd,region,#True)
EndIf
hbitmap=CaptureTransparent(hwnd,box\left,box\top,box\right-box\left,box\bottom-box\top)
SendMessage_(GadgetID(0),#STM_SETIMAGE,#IMAGE_BITMAP,hbitmap)
SetClassLong_(hwnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
ShowWindow_(GetParent_(hwnd),#SW_HIDE)
HideWindow(0,0)
DestroyWindow_(GetParent_(hwnd))
MouseBtnDownX=0
MouseBtnDownY=0
startcapture=0
originalx=0
originaly=0
lastwidth=0
lastheight=0
DeleteObject_(hpen)
EndSelect
EndSelect
ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure
Procedure startcapture(type.l,rectwidth=0,rectheight=0)
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)
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))
SetWindowLong_(GadgetID(imagegad), #GWL_USERDATA, type)
EndProcedure
If OpenWindow(0,100,150,541,555,"t",#PB_Window_SystemMenu)
ImageGadget(0,10,10,300,300,0)
ImageGadget(1,10,320,50,50,0,#PB_Image_Border)
SetProp_(GadgetID(1),"OldProc",SetWindowLong_(GadgetID(1), #GWL_WNDPROC, @wincapcallback()))
RegisterHotKey_(WindowID(0),1,#MOD_SHIFT|#MOD_CONTROL,#VK_F11)
RegisterHotKey_(WindowID(0),2,#MOD_SHIFT|#MOD_CONTROL,#VK_F10)
RegisterHotKey_(WindowID(0),3,#MOD_SHIFT|#MOD_CONTROL,#VK_F12)
Repeat
Select WaitWindowEvent()
Case #WM_HOTKEY
Select EventwParam()
Case 1
HideWindow(0,1)
Delay(200)
startcapture(#cap_any)
Case 2
HideWindow(0,1)
Delay(200)
startcapture(#cap_rectangle)
Case 3
HideWindow(0,1)
Delay(200)
startcapture(#cap_ellipse)
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf