Moving an object with mouse on canvas
Posted: Fri Jan 15, 2016 6:52 am
Just a simple programme to demonstrate a method of using the mouse to move an object on a canvas. The canvas is needed to pick up the mouse events etc.
Just one object in the programme gets a lot more complicated with multiple objects to chose from etc. Kept programme as simple as possible if anyone can make it simpler please post here.
Just one object in the programme gets a lot more complicated with multiple objects to chose from etc. Kept programme as simple as possible if anyone can make it simpler please post here.
Code: Select all
EnableExplicit
;Gadget Structure
Structure UsedGadget
ID.l
Type.s
x.l
y.l
Width.i
Height.i
EndStructure
Global MyGadgets.UsedGadget
MyGadgets\x = 45
MyGadgets\y = 25
MyGadgets\Width = 120
MyGadgets\Height= 40
Global frmMain.l,cvsTest.l,GadX.i,GadY.i,ActiveMove.i
Define Event.i,cx.i,cy,i
frmMain = OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu)
cvsTest = CanvasGadget(#PB_Any, 0, 0, 600, 400)
MyGadgets\ID = ButtonGadget(#PB_Any, MyGadgets\x, MyGadgets\y , MyGadgets\Width, MyGadgets\Height, "Test")
ActiveMove = #False
Macro GadgetHoverCheck(x, y)
(((Not x < MyGadgets\x) & (Not y< MyGadgets\y)) &(Not x>=(MyGadgets\x+MyGadgets\Width)) & (Not y>=(MyGadgets\y+MyGadgets\Height)))
EndMacro
Procedure.i HitTest(x, y)
If GadgetHoverCheck(x,y)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure MoveGadget(x,y)
MyGadgets\x = GadgetX(MyGadgets\ID)
MyGadgets\y = GadgetY(MyGadgets\ID)
ResizeGadget(MyGadgets\ID, x, y, #PB_Ignore, #PB_Ignore)
EndProcedure
Repeat
Event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case cvsTest
Select EventType ()
Case #PB_EventType_LeftButtonDown
;Get current mouse co-ordinates
cx = WindowMouseX(frmMain)
cy = WindowMouseY(frmMain)
If HitTest(cx,cy)
gadx = cx - MyGadgets\x
gady = cy - MyGadgets\y
ActiveMove = #True
EndIf
Case #PB_EventType_LeftButtonUp
ActiveMove = #False
MyGadgets\x = GadgetX(MyGadgets\ID)
MyGadgets\y = GadgetY(MyGadgets\ID)
Case #PB_EventType_MouseMove
If ActiveMove
;Get current mouse co-ordinates
cx = WindowMouseX(frmMain)
cy = WindowMouseY(frmMain)
If cx > -1 And cy > -1
MoveGadget(cx - gadx,cy - gady)
EndIf
EndIf
EndSelect ;EventType ()
EndSelect ;EventGadget()
EndSelect ;Event
Until Event = #PB_Event_CloseWindow