Select image rectangle

Share your advanced PureBasic knowledge/code with the community.
El_Choni
TailBite Expert
TailBite Expert
Posts: 1007
Joined: Fri Apr 25, 2003 6:09 pm
Location: Spain

Select image rectangle

Post by El_Choni »

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
Last edited by El_Choni on Sun May 15, 2005 2:43 am, edited 5 times in total.
El_Choni
Pantcho!!
Enthusiast
Enthusiast
Posts: 538
Joined: Tue Feb 24, 2004 3:43 am
Location: Israel
Contact:

Post by Pantcho!! »

8) Great code just what i was looking for! :)

thank you!
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Select image rectangle

Post by IdeasVacuum »

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
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Select image rectangle

Post by IdeasVacuum »

Actually, BasicallyPure has nailed-down the best solution using a CanvasGadget()
Selector_Module.pbi
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
normeus
Enthusiast
Enthusiast
Posts: 472
Joined: Fri Apr 20, 2012 8:09 pm
Contact:

Re: Select image rectangle

Post by normeus »

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

Code: Select all

            GrabImage(1, 2 , stX-#lx, stY-#ty, width, height)
             SetClipboardImage(2)
Norm
google Translate;Makes my jokes fall flat- Fait mes blagues tombent à plat- Machte meine Witze verpuffen- Eh cumpari ci vo sunari
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Select image rectangle

Post by Kwai chang caine »

Works great after help of normeus :wink:
Thanks for sharing ElChoni 8), a little bite late ...:oops:
ImageThe happiness is a road...
Not a destination
Post Reply