' Win32 API POINT UDT
Private Type POINTAPI
x As Long
y As Long
End Type
' Win32 API Declarations
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
' HotSpot User Defined Type Defintion
Private Type udtHotSpot
X1 As Single ' Left Coord
Y1 As Single ' Top Coord
X2 As Single ' Right Coord
Y2 As Single ' Bottom Coord
Text As String ' Caption/Label
Active As Boolean ' Is Mouse Over this HotSpot?
Shadow As Boolean ' Use a Shadow?
End Type
Private mtHotSpots() As udtHotSpot ' Array of HotSpot UDTs
Private mlHotSpots As Long ' Number of HotSpots in Array
Private mlLastHotSpot As Long ' Last Activated HotSpot
Private mdScrollSpeed As Single ' Scrolling Speed of Menu
Private mlLastDown As Long ' Last HotSpot Mouse Was Held Down On
' Scroll Menu and HotSpot Color Constants
Private Const HS_FORECOLOR = vbWhite
Private Const HS_BACKCOLOR = &H80FF& '&HA0FF&
Private Const SA_BACKCOLOR = &H80FF&
Private Const HS_SHADOW = vbBlack
Private Const HS_SPACER = "::"
' Maximum Menu Scrolling Speed in Pixels
Private Const MAX_SCROLLSPEED = 5
Private Sub Form_Load()
' Initialize the Scroll Area (picFrame)
picFrame.BackColor = SA_BACKCOLOR
' Use Pixels as the ScaleMode for Everything
Me.ScaleMode = vbPixels
picFrame.ScaleMode = vbPixels
picFrame.Height = 25
picFrame.Align = vbAlignTop
picFrame.AutoRedraw = True
Me.Height = (picFrame.Height + (Me.Height / Screen.TwipsPerPixelY - Me.ScaleHeight)) * Screen.TwipsPerPixelY
' Create 10 HotSpots in the Menu
Do While mlHotSpots < 10
mlHotSpots = mlHotSpots + 1
ReDim Preserve mtHotSpots(1 To mlHotSpots)
' Make them 100 Pixels wide and space them 15 Pixels apart
With mtHotSpots(mlHotSpots)
.Y1 = 0
.X1 = 115 * (mlHotSpots - 1)
.Y2 = 20
.X2 = .X1 + 100
.Text = "hotspot " & mlHotSpots
.Active = False
.Shadow = True
End With
Loop
' Start the Timer which will Scroll the menu
tmrScroll.Enabled = True
End Sub
Private Sub tmrScroll_Timer()
' Reposition the HotSpots
Dim lIndex As Long
For lIndex = 1 To mlHotSpots
With mtHotSpots(lIndex)
.X1 = .X1 + mdScrollSpeed
If .X1 < -100 And Sgn(mdScrollSpeed) = -1 Then
.X1 = mtHotSpots(((lIndex + mlHotSpots - 2) Mod mlHotSpots) + 1).X2 + 15
ElseIf .X1 > picFrame.ScaleWidth And Sgn(mdScrollSpeed) = 1 Then
.X1 = mtHotSpots((lIndex Mod mlHotSpots) + 1).X1 - 115
End If
.X2 = .X1 + 100
End With
Next
' Determine if we're over a HotSpot, Clicking One and the speed at which
' the menu is scrolling (as well as direction)
HitTest
' Redraw the Menu
PaintScroll
End Sub
' This function retuns the Smallest of 2 given values
Private Function GetMin(ByVal A As Variant, ByVal B As Variant) As Variant
If A < B Then
GetMin = A
Else
GetMin = B
End If
End Function
' This Function returns the Largest of 2 given values
Private Function GetMax(ByVal A As Variant, ByVal B As Variant) As Variant
If A > B Then
GetMax = A
Else
GetMax = B
End If
End Function
' This Subroutine Redraws the menu and HotSpots
Private Sub PaintScroll()
Dim lIndex As Long
' Clear the Menu Picturebox (picFrame)
picFrame.Cls
' Step through the HotSpot Array
For lIndex = 1 To mlHotSpots
With mtHotSpots(lIndex)
picFrame.FontBold = True
picFrame.FontSize = 8
' Draw the Background of the HotSpot
picFrame.Line (.X1, .Y1)-(.X2, .Y2), HS_BACKCOLOR, BF
' Draw Spacer Shadow
If .Shadow Then
picFrame.ForeColor = HS_SHADOW
picFrame.CurrentX = .X2 + 7
picFrame.CurrentY = .Y1 + (((.Y2 - .Y1) - picFrame.TextHeight(HS_SPACER)) / 2) + 1
picFrame.Print HS_SPACER
End If
' Set the HotSpot Forecolor
picFrame.ForeColor = HS_FORECOLOR
' Draw Spacer
picFrame.CurrentX = .X2 + 7
picFrame.CurrentY = .Y1 + (((.Y2 - .Y1) - picFrame.TextHeight(HS_SPACER)) / 2)
picFrame.Print HS_SPACER
' Determine FontSize, depending on whether the user
' is hovering over this hotspot at the time.
picFrame.FontSize = IIf(.Active, 12, 8)
' Draw Caption Shadow
If .Shadow Then
picFrame.ForeColor = HS_SHADOW
' Center the HotSpot Caption Vertically and Horizontally
picFrame.CurrentX = .X1 + (((.X2 - .X1) - picFrame.TextWidth(.Text)) / 2) + IIf(.Active, 2, 1)
picFrame.CurrentY = .Y1 + (((.Y2 - .Y1) - picFrame.TextHeight(.Text)) / 2) + IIf(.Active, 2, 1)
' Print the HotSpot Caption
picFrame.Print .Text
picFrame.ForeColor = HS_FORECOLOR
End If
' Draw Caption
' Center the HotSpot Caption Vertically and Horizontally
picFrame.CurrentX = .X1 + (((.X2 - .X1) - picFrame.TextWidth(.Text)) / 2)
picFrame.CurrentY = .Y1 + (((.Y2 - .Y1) - picFrame.TextHeight(.Text)) / 2)
' Print the HotSpot Caption
picFrame.Print .Text
End With
Next
End Sub
' This Subroutine calculates the Mouse Coords in terms of the
' Menu Container (picFrame) and calculates menu scroll speed
' HotSpot Activation and whether a "Click" event should be raised.
Private Sub HitTest()
Dim tPOINT As POINTAPI
Dim lIndex As Long, lX As Long, lY As Long
Dim bMouseDown As Boolean
Static bLastMouseDown As Boolean
' Get the status of the Left Mouse Button
bMouseDown = GetAsyncKeyState(vbLeftButton)
' Get the current Mouse Position (in Screen Coords)
Call GetCursorPos(tPOINT)
' Convert the Screen Coords to be relative to the Menu
' Container (picFrame)
Call ScreenToClient(picFrame.hwnd, tPOINT)
' Store the Coords in easier to use variables
lX = tPOINT.x
lY = tPOINT.y
' Calculate the Menu Scroll Speed and Direction
With picFrame
' If the Mouse is within the menu area, calculate scroll speed
' depending on position, i.e. to the left half of the menu, scroll right
' to the right half of the menu, scroll left.
If lY >= 0 And lY <= .ScaleHeight And lX >= 0 And lX <= .ScaleWidth Then
mdScrollSpeed = -GetMin(MAX_SCROLLSPEED, (MAX_SCROLLSPEED / (picFrame.ScaleWidth / 2)) * (tPOINT.x - (picFrame.ScaleWidth / 2)))
Else
' If not in the menu, use the maximum scroll speed
'mdScrollSpeed = -MAX_SCROLLSPEED
End If
End With
' Loop through the HotSpot UDT's to see if the
' Mouse is over a HotSpot
For lIndex = 1 To mlHotSpots
With mtHotSpots(lIndex)
If lX >= .X1 And lX <= .X2 And lY >= .Y1 And lY <= .Y2 Then
Exit For
End If
End With
Next
' If it isn't, default the Index value to Zero (no hotspot)
If lIndex > mlHotSpots Then lIndex = 0
' If a Hotspot is no longer active, deactivate it
If mlLastHotSpot > 0 And lIndex <> mlLastHotSpot Then
' Restore previous hotspot
mtHotSpots(mlLastHotSpot).Active = False
End If
' Remeber the current hotspot (if any)
mlLastHotSpot = lIndex
' If Hovering over a HotSpot, Activate it
If lIndex > 0 Then
mtHotSpots(lIndex).Active = True
' Change the Mouse Point to the Hand Icon (Stored in Resource File)
If picFrame.MousePointer <> vbCustom Then
picFrame.MouseIcon = LoadResPicture("HANDICON", vbResIcon)
picFrame.MousePointer = vbCustom
End If
'If the Mouse is no longer pressed...
If Not bMouseDown Then
' And it was previously held down on the same HotSpot
If bLastMouseDown And mlLastDown = lIndex Then
' Trigger a Click event passing in the HotSpot Index
Call Click(lIndex)
End If
' Remember the HotSpot index we're over
mlLastDown = lIndex
End If
Else
' Restore the Mouse Pointer
picFrame.MousePointer = vbNormal
End If
' Remember the status of the Mouse Button
bLastMouseDown = bMouseDown
End Sub
' This Subroutine acts as the "Click()" Event for the HotSpots
' The HotSpot being clicked is represented by the "Index" parameter.
Private Sub Click(ByVal Index As Long)
Debug.Print "Clicked: """ & mtHotSpots(Index).Text & """"
End Sub
