Code: Select all
; RectangleSelector.pb
; by BasicallyPure
; 8/28/2013
; PB 5.20 beta12 LTS(x86)
; windows only
; forum: http://www.purebasic.fr/english/viewtopic.php?f=40&t=56305
;
; Purpose: Use the mouse to select a rectangular area on a window.
; You can drag the selection rectangle with the mouse or resize the
; selection by draging the small square in the lower right corner.
; Clicking outside the selection will remove the selection rectangle.
; The structured variable 'selection.SelType' will contain the x y
; boundaries of the selected area.
EnableExplicit
Structure SelType
left.i ; left edge 'x' value of selected area
right.i ; right edge 'x' value of selected area
top.i ; top edge 'y' value of selected area
bottom.i ; bottom edge 'y' value of selected area
active.i ; set to #False when image is new or updated
sFlag.i ; if #True an area is selected
limLeft.i ; left boundary limit of selection area (window coordinates)
limRight.i ; right boundary limit of selection area (window coordinates)
limTop.i ; top boundary limit of selection area (window coordinates)
limBottom.i ; bottom boundary limit of selection area (window coordinates)
EndStructure
Define selection.SelType
Procedure Update_Status()
; update the information displayed in the status bar
Protected text.s, lenX.i, lenY.i
Shared selection.SelType
With selection
lenX = \right - \left + 1
lenY = \bottom - \top + 1
If IsStatusBar(0)
StatusBarText(0,0,"Size = " + Str(lenX) + " x " + Str(lenY))
StatusBarText(0,1,"x/y ratio = " + StrF(lenX / lenY,5))
StatusBarText(0,2,"xLeft = " + Str(\left - GadgetX(0)))
StatusBarText(0,3,"yTop = " + Str(\top - GadgetY(0)))
StatusBarText(0,4,"xRight = " + Str(\right - GadgetX(0)))
StatusBarText(0,5,"yBottom = " + Str(\bottom - GadgetY(0)))
If \sFlag : text = "True" : Else : text = "False" : EndIf
StatusBarText(0,6,"Selection = " + text)
EndIf
EndWith
EndProcedure
Procedure SelectArea()
; Use the mouse to select an area on a window.
Shared selection.SelType
Static.i x, y, lenX, lenY, lastX, lastY, boxSet
Static.i WIC = #PB_Window_InnerCoordinate
Protected.i drag, stretch, msx, msy, ox, oy
Protected Win = GetActiveWindow()
With selection
x = WindowMouseX(Win)
y = WindowMouseY(Win)
If x < \limLeft Or x > \limRight Or y < \limTop Or y > \limBottom
ProcedureReturn
EndIf
If boxSet = #True And x > \right-9 And x < \right And y > \bottom-9 And y < \bottom
stretch = #True ; resize selection rectangle is active
x = lastX
y = lastY
ElseIf x > \left And x < \right And y > \top And y < \bottom
drag = #True ; drage selection rectangle is active
ox = lenX >> 1
oy = lenY >> 1
; move cursor to center of selected area
SetCursorPos_(\left+Abs(ox)+WindowX(Win, WIC), \top+Abs(oy)+WindowY(Win,WIC))
Else
drag = #False
EndIf
While WaitWindowEvent(100) <> #WM_LBUTTONUP
StartDrawing(WindowOutput(Win))
DrawingMode(#PB_2DDrawing_XOr)
If \active = #True
; erase previous selection rectangle
LineXY(lastX, lastY, lastX + lenX, lastY, 0)
LineXY(lastX, lastY, lastX, lastY + lenY, 0)
LineXY(lastX, lastY + lenY, lastX + lenX, lastY + lenY, 0)
LineXY(lastX + lenX, lastY, lastX + lenX, lastY + lenY, 0)
If boxSet = #True
boxSet = #False
Box(\right - 8, \bottom - 8, 8, 8, 0)
EndIf
Else
; activate for a new or freshly updated image
\active = #True
lastX = x
lastY = y
boxSet = #False
EndIf
msx = WindowMouseX(Win)
msy = WindowMouseY(Win)
; check if mouse cursor is in bounds
If msx >= \limLeft And msx < \limRight And msy >= \limTop And msy < \limBottom
If drag = #False ; calculate size of next selection outline
lenX = msx - x
lenY = msy - y
Else ; drag the selection outline
x = msx - lenX >> 1
y = msy - lenY >> 1
; prevent out of bounds dragging
If x < \limLeft : x = \limLeft : EndIf ; check left side
If y < \limTop : y = \limTop : EndIf ; check top side
If x > \limRight -1 - lenX ; check right side
x = \limRight -1 - lenX
EndIf
If y > \limBottom -1 - lenY ; check bottom side
y = \limBottom -1 - lenY
EndIf
EndIf
EndIf
; draw the selection rectangle
LineXY(x, y, x + lenX, y, 0)
LineXY(x, y, x, y + lenY, 0)
LineXY(x, y + lenY, x + lenX, y + lenY, 0)
LineXY(x + lenX, y, x + lenX, y + lenY, 0)
lastX = x
lastY = y
StopDrawing()
\left = x
\top = y
\right = x + lenX
\bottom = y + lenY
Update_Status()
Wend
If \left > \right ; fix left/right crossover
Swap \left, \right : x + lenX : lastX = x : lenX * -1
EndIf
If \top > \bottom ; fix top/bottom crossover
Swap \top, \bottom : y + lenY : lastY = y : lenY * -1
EndIf
; mouse button was released
If \left = \right And \top = \bottom ; single point so no selection
\sFlag = #False
Else ; a valid selection has been made
\sFlag = #True
; draw the selection resize box
StartDrawing(WindowOutput(Win))
DrawingMode(#PB_2DDrawing_XOr)
Box(\right - 8, \bottom - 8, 8, 8, 0)
boxSet = #True
StopDrawing()
EndIf
EndWith
Update_Status()
EndProcedure
#WinNum = 0
If OpenWindow(#WinNum,0,0,750,500,"Rectangle Selection Demo",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CreateImage(0,640,480,24,$B8CE8C)
CreateStatusBar(0,WindowID(#WinNum))
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
ResizeWindow(#WinNum,#PB_Ignore,#PB_Ignore,#PB_Ignore,WindowHeight(#WinNum)+StatusBarHeight(0))
ImageGadget(0,100,10,640,480,ImageID(0))
ButtonGadget(1,10,10,80,30,"Unselect")
; set up selection area boundaries using image gadget 0
With selection
\limLeft = GadgetX(0)
\limTop = GadgetY(0)
\limRight = \limLeft + GadgetWidth(0)
\limBottom = \limTop + GadgetHeight(0)
EndWith
Repeat ; event loop
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 1 ; unselect programatically
If selection\sFlag
With selection
\active = #False
\sFlag = #False
\top = \bottom
\left = \right
EndWith
SetGadgetState(0,ImageID(0))
Update_Status()
EndIf
EndSelect
Case #WM_LBUTTONDOWN
SelectArea()
EndSelect
ForEver
EndIf
