Code: (Select All)
Option _Explicit
$Color:32
Type ToggleButton
active As Integer
state As Integer
x As Integer
y As Integer
End Type
ReDim Shared Toggles(1000) As ToggleButton
ReDim Shared As Integer TogglesInUse
Dim Shared As Long Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
Screen _NewImage(640, 480, 32)
Dim As Long foo, fred, MBS
foo = CreateToggle(100, 100) 'create a name for the toggle and decide where to place it on the screen
fred = CreateToggle(300, 300) 'a second toggle to make certain we work with multiples well
Do
Cls
MBS = MouseButtonStatus 'get the mouse status once here, to be used anywhere else in our processes
ProcessToggles MBS 'check to see if we've clicked on the active toggles
DisplayToggles 'display them after any change
Print "Toggle foo's value:"; GetToggleValue(foo) 'we can get the value back here
Print "Toggle fred's value:"; GetToggleValue(fred) 'we can get the value back here
_Limit 30
_Display
Loop Until _KeyDown(27)
FreeToggle 0 'free all toggles for use later
System
Function GetToggleValue (handle As Long)
If handle < 0 Or handle > 1000 Then Exit Function
GetToggleValue = Toggles(handle).state
End Function
Sub FreeToggle (handle As Long)
If handle < 0 Or handle > 1000 Then Exit Sub
If handle = 0 Then TogglesInUse = 0
Toggles(handle).active = 0
End Sub
Sub ProcessToggles (MBS As Long)
Dim As Long i
If MBS And 8 Then 'left button was clicked
For i = 1 To TogglesInUse
If _MouseX >= Toggles(i).x And _MouseX <= Toggles(i).x + 100 Then
If _MouseY >= Toggles(i).y And _MouseY <= Toggles(i).y + 24 Then
Toggles(i).state = Not Toggles(i).state
End If
End If
Next
End If
End Sub
Sub DisplayToggles
Dim As Long i, x, y, state, w, t, cx, cy
Dim As Long DC, BGC
DC = _DefaultColor: BGC = _BackgroundColor
w = 25: t = 12
Color White, 0
For i = 1 To TogglesInUse
If Toggles(i).active Then
x = Toggles(i).x
y = Toggles(i).y
state = Toggles(i).state
'draw the whole toggle
cx = x + 2 * w: cy = y + t
Line (x, y)-Step(100, 24), DarkGray, BF
If state Then 'the toggle has been clicked to the right (ON by default)
EllipseFill cx + w, cy, w, t, Green
_PrintString (cx + w - 8, cy - 8), "ON"
Else
EllipseFill cx - w, cy, w, t, Red
_PrintString (cx - w - 12, cy - 8), "OFF"
End If
End If
Next
Color DC, BGC
End Sub
Function CreateToggle (x As Long, y As Long)
Dim As Long i
For i = 1 To TogglesInUse
If Toggles(i).active = 0 Then
Toggles(i).active = -1
Toggles(i).x = x
Toggles(i).y = y
CreateToggle = i
Exit Function
End If
Next
TogglesInUse = i
Toggles(i).active = -1
Toggles(i).x = x
Toggles(i).y = y
CreateToggle = i
End Function
Sub EllipseFill (CX As Integer, CY As Integer, a As Integer, b As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' C = fill color
If a = 0 Or b = 0 Then Exit Sub
Dim h2 As _Integer64
Dim w2 As _Integer64
Dim h2w2 As _Integer64
Dim x As Integer
Dim y As Integer
w2 = a * a
h2 = b * b
h2w2 = h2 * w2
Line (CX - a, CY)-(CX + a, CY), C, BF
Do While y < b
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Function MouseButtonStatus% 'Mouse Button Status
Static StartTimer As _Float
Static ButtonDown As Integer
Const ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
'Shared Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
Dim As Long tempMBS, BD
While _MouseInput 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
Select Case Sgn(_MouseWheel)
Case 1: tempMBS = tempMBS Or 512
Case -1: tempMBS = tempMBS Or 1024
End Select
Wend
If _MouseButton(1) Then tempMBS = tempMBS Or 1
If _MouseButton(2) Then tempMBS = tempMBS Or 2
If _MouseButton(3) Then tempMBS = tempMBS Or 4
If StartTimer = 0 Then
If _MouseButton(1) Then 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(2) Then
ButtonDown = 2: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(3) Then
ButtonDown = 3: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
End If
Else
BD = ButtonDown Mod 3
If BD = 0 Then BD = 3
If Timer(0.01) - StartTimer <= ClickLimit Then 'Button was down, then up, within time limit. It's a click
If _MouseButton(BD) = 0 Then tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
Else
If _MouseButton(BD) = 0 Then 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MouseX: Mouse_EndY = _MouseY
Else 'We've now started the hold event
tempMBS = tempMBS Or 32 * 2 ^ ButtonDown
End If
End If
End If
MouseButtonStatus = tempMBS
End Function
For a program which I'm working on which has several settings which the user can toggle on and off, and which I thought I'd share in case anyone needed or was interested in this.
