Microsoft Small Basic

Program Listing: TWF500-0

List Program

'================================================='
' Drag Object Example (v1.01)
' by GoToLoop (2014/Feb)
'
' TWF500-0
'
' http://social.msdn.microsoft.com/Forums/en-US
' /2d5ec679-25e5-4d98-986a-c662da26ad89
' /drag-and-drop-performance-troubleshooting
'================================================='

'__________________________________________________________'
' Init Graphics Window:
GW = 640
GH = 480

GraphicsWindow.Title = "Drag Object Example"
GraphicsWindow.CanResize = "False"
GraphicsWindow.Width = GW
GraphicsWindow.Height = GH
GraphicsWindow.BackgroundColor = "White"
GraphicsWindow.PenColor = "Black"

' Init Sprite Properties:
DIAM = 150
RAD = DIAM/2

x = (GW - DIAM)/2
y = (GH - DIAM)/2

' Create Sprite Shape:
GraphicsWindow.BrushColor = GraphicsWindow.GetRandomColor()
sprite = Shapes.AddEllipse(DIAM, DIAM)
Shapes.Move(sprite x, y)

' Activate Mouse Events:
GraphicsWindow.MouseDown = MouseClickedEvent
GraphicsWindow.MouseUp = MouseReleasedEvent
'__________________________________________________________'

' Main Loop:
'__________________________________________________________'
Loop:
mx = GraphicsWindow.MouseX - RAD
my = GraphicsWindow.MouseY - RAD

If isDown And isHovering Then
DragSpriteToPointerLocation()
EndIf

Program.Delay(10)
Goto Loop
'__________________________________________________________'

' Asynchronous Event Callbacks:
'__________________________________________________________'
Sub MouseClickedEvent
CheckPointerOverSpriteLocation()
isDown = "True"
EndSub
'__________________________________________________________'
Sub MouseReleasedEvent
isDown= "False"
EndSub
'__________________________________________________________'

' Sprite Subroutines:
'__________________________________________________________'
Sub CheckPointerOverSpriteLocation
If Math.Abs(mx - x) < RAD And Math.Abs(my - y) < RAD Then
isHovering = "True"
Else
isHovering = "False"
EndIf
EndSub
'__________________________________________________________'
Sub DragSpriteToPointerLocation
x = mx
y = my
Shapes.Move(sprite x, y)
EndSub
'__________________________________________________________'