Hi, very cool tip, I'll use it in the ImageViewer. I've modified it so it doesn't repaint when the cursor is not moving and so the cursor is drawn at the correct position:
Code: Select all
;Drag with left mouse button to select a part of the screen
;Click the right 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)
ProcedureReturn
EndProcedure
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, "")
CreateGadgetList(WindowID())
ImageGadget(1, 0, 0, Window_Width, Window_Height, Pic_desktop)
Layer1_desktop = CreateImage(2, Window_Width, Window_Height)
Repeat
Select WindowEvent()
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_RBUTTONDOWN
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
Case #WM_LBUTTONUP:drawbox = 0
EndSelect
Delay(1)
ForEver
End