10-17-2024, 05:37 PM
Code: (Select All)
Type ToolTipInfo
text As String
x As Integer
y As Integer
End Type
Dim Shared RegisteredTips(100) As ToolTipInfo
Screen _NewImage(800, 600, 32)
RegisterToolTip "Cheese is tasty and made from moo moo cows!", 245, 100
RegisterToolTip "A fridge is the cold thing which folks hold their cheeses in!", 380, 100
Do
Cls
_PrintString (100, 100), "People like cheese in their fridge ."
While _MouseInput: Wend
DisplayToolTips
_Limit 30 'don't melt my damn CPU
_Display
Loop Until _KeyDown(27)
Sub RegisterToolTip (what$, x, y)
If what$ = "" Then Exit Sub 'can't register nothing
If x < 0 Or y < 0 Then Exit Sub 'don't put your tooltip off the damn screen!
If x > _Width - _FontWidth Or y > _Height - _FontHeight Then Exit Sub 'honestly, I say, don't put your tooltip off the damn screen!
For i = 1 To 100
If RegisteredTips(i).text = "" Then 'it's a free tooltip spot
RegisteredTips(i).text = what$
RegisteredTips(i).x = x
RegisteredTips(i).y = y
Exit Sub 'We're done. We've registered!
End If
Next
'If we make it to here, we failed. Some dummy probably has more than 100 tooltips, or else they registered them inside a loop, or such.
'(Note, this dummy could be your's truly...)
End Sub
Sub FreeToolTip (x, y)
For i = 1 To 100
If RegisteredTips(i).x = x And RegisteredTips(i).y = y Then 'it's a free tooltip spot
RegisteredTips(i).text = ""
RegisteredTips(i).x = -1
RegisteredTips(i).y = -1
Exit Sub 'We're done. We've registered!
End If
Next
End Sub
Sub DisplayToolTips
Static Qbox As Long
d = _Dest
If Qbox = 0 Then
Qbox = _NewImage(_FontWidth, _FontHeight, 32)
_Dest Qbox
Color _RGB32(255, 255, 0), _RGB32(0, 0, 128) 'Yellow on blue
_PrintString (0, 0), "?"
End If
For i = 1 To 100
If RegisteredTips(i).text <> "" Then
_PutImage (RegisteredTips(i).x, RegisteredTips(i).y), Qbox
If _MouseX >= RegisteredTips(i).x And _MouseX < RegisteredTips(i).x + _FontWidth Then 'in right spot
If _MouseY >= RegisteredTips(i).y And _MouseY < RegisteredTips(i).y + _FontHeight Then 'we're REALLY in the right spot
'show that damn tool tip
temp = _PrintWidth(RegisteredTips(i).text)
h = (temp \ (_Width \ 2) + 3) * _FontHeight
temp = _NewImage(_Width \ 2, h, 32)
_Dest temp
Cls , _RGB32(255, 255, 255) 'white background
Color _RGB32(0, 0, 0), 0
Locate 2, 1: Print RegisteredTips(i).text;
_Dest d
_PutImage (RegisteredTips(i).x, RegisteredTips(i).y - h), temp
_FreeImage temp
End If
End If
End If
Next
_Dest d
End Sub
Scroll over the Question Marks (?) to activate the tool tips.
