PureBasic Forums - English

Posted: **Sun May 15, 2005 1:58 am**

Code updated for 5.20+

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

Posted: **Sun May 15, 2005 2:04 am**

Great code just what i was looking for!

thank you!

Posted: **Wed Jan 20, 2016 1:32 pm**

Interesting El_Choni, but I can't quite follow the code. Where do the magic numbers #lx, #ty, #rx, #by come from?

Code: Select all

SetClipboardImage(ImageID(2))

[ERROR] Invalid memory access

Posted: **Wed Jan 20, 2016 11:11 pm**

Actually, BasicallyPure has nailed-down the best solution using a CanvasGadget()
Selector_Module.pbi

Posted: **Thu Jan 21, 2016 2:19 am**

just change these two lines ( image number , handle, etc.. )

Code: Select all

            GrabImage(1, 2 , stX-#lx, stY-#ty, width, height)
             SetClipboardImage(2)

Norm

Posted: **Thu Jan 21, 2016 6:57 pm**

Works great after help of normeus

Thanks for sharing ElChoni

, a little bite late ...

PureBasic Forums - English

Select image rectangle

Select image rectangle

Re: Select image rectangle

Re: Select image rectangle

Re: Select image rectangle

Re: Select image rectangle