Hi,
This has been probably posted before, but I haven't found it, and I think it's simple enough to be used in very different situations. So there it goes:
Code: Select all
Global x.w, y.w, oX, oY, hArrow, hCross
hArrow = LoadCursor_(0, #IDC_ARROW)
hCross = LoadCursor_(0, #IDC_CROSS)
#lx = 8
#ty = 8
#rx = 283
#by = 182
#Copy = 0
Procedure WndProc(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_LBUTTONDOWN
oX = lParam&$ffff
oY = lParam>>16
If GetCapture_()<>hWnd
SetCapture_(hWnd)
EndIf
CopyImage(0, 1)
RedrawWindow_(hWnd, 0, 0, #RDW_INTERNALPAINT|#RDW_INVALIDATE)
Case #WM_MOUSEMOVE
x.w = lParam&$ffff
y.w = lParam>>16
If (x>#lx And x<#rx And y>#ty And y<#by) Or GetCapture_()=hWnd
SetCursor_(hCross)
Else
SetCursor_(hArrow)
EndIf
If GetCapture_()=hWnd And wParam&#MK_LBUTTON
ImageID = ImageID(0)
StartDrawing(ImageOutput(1))
DrawImage(ImageID, 0, 0)
DrawingMode(2|4)
Box(oX-#lx, oY-#ty, x-oX, y-oY)
StopDrawing()
RedrawWindow_(hWnd, 0, 0, #RDW_INTERNALPAINT|#RDW_INVALIDATE)
EndIf
Case #WM_LBUTTONUP
If GetCapture_()=hWnd
ReleaseCapture_()
EndIf
Case #WM_PAINT
StartDrawing(WindowOutput(0))
DrawImage(ImageID(1), 8, 8)
StopDrawing()
EndSelect
ProcedureReturn result
EndProcedure
If OpenWindow(0, 320, 256, 291, 190, "PureBasic Window", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
*Windows = AllocateMemory(#MAX_PATH)
GetWindowsDirectory_(*Windows, #MAX_PATH)
Windows$ = PeekS(*Windows)
FreeMemory(*Windows)
If Right(Windows$, 1)<>"\":Windows$+"\":EndIf
If LoadImage(0, Windows$+"winnt256.bmp")=0:LoadImage(0, Windows$+"winnt.bmp"):EndIf
If IsImage(0)
CopyImage(0, 1)
AddKeyboardShortcut(0, #PB_Shortcut_C|#PB_Shortcut_Control, #Copy)
SetWindowCallback(@WndProc())
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Menu
If EventGadget()=#Copy
If x<oX:stX = x:width = oX-x:Else:stX = oX:width = x-oX:EndIf
If y<oY:stY = y:height = oY-y:Else:stY = oY:height = y-oY:EndIf
If IsImage(2):FreeImage(2):EndIf
GrabImage(0, 2, stX-#lx, stY-#ty, width, height)
SetClipboardImage(ImageID(2))
EndIf
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit
EndIf
EndIf