Mira este ejemplo:
Private Declare Function ExtraerIconoLib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String,ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long,ByVal nIcons As Long) As Long
Private Declare Function DibujarIconoLib "user32" Alias "DrawIconEx" (ByVal hdc As Long, ByVal xLeft AsLong, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long,ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByValhbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function EliminarIcono Lib "user32" Alias "DestroyIcon" (ByVal hIcon As Long) As Long
Private Type MenuItem
X As Long
Y As Long
Width As Long
Height As Long
End Type
Private DMenu(4) As MenuItem
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_LostFocus()
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Distancia As Long
Dim Top As Long
Dim TamMin As Long
Dim TamMax As Long
Dim DisActuar As Long
Dim CX As Long
Dim CY As Long
Dim I As Long
Dim Espaciado As Long
Dim tLeftMin As Long
Dim Icono As Long
Dim nWidth As Long
Espaciado = 10
Top = 80
TamMax = 96
TamMin = 36
DisActuar = 122
'tLeftMin = (Me.ScaleWidth - ((TamMin + Espaciado) * (UBound(DMenu)))) / 2
Cls
For I = LBound(DMenu) To UBound(DMenu)
With DMenu(I)
CY = .Y + .Height / 2
CX = .X + .Width / 2
Distancia = Sqr((X - CX) ^ 2 + (Y - CY) ^ 2)
If Distancia <= DisActuar Then 'si la distancia es menor o igual a lo minimo
.Width = TamMin + (DisActuar - Distancia) * (TamMax - TamMin) / DisActuar
.Height = .Width
.Y = Top - .Height / 2
Else
.Width = TamMin
.Height = TamMin
.Y = Top - .Height / 2
End If
If I > LBound(DMenu) Then
.X = DMenu(I - 1).X + DMenu(I - 1).Width + Espaciado
Else
.X = tLeftMin - .Width / 2
End If
'Call ExtraerIcono("shell32.dll", I, Icono, ByVal 0&, 1)
'Call DibujarIcono(Me.hdc, .X, .Y, Icono, .Width, .Height, 0, 0, &H3)
'Call EliminarIcono(Icono)
End With
Next
nWidth = (DMenu(UBound(DMenu)).X + DMenu(UBound(DMenu)).Width) - DMenu(LBound(DMenu)).X
tLeftMin = (Me.ScaleWidth - nWidth) / 2
For I = LBound(DMenu) To UBound(DMenu)
With DMenu(I)
If I > LBound(DMenu) Then
.X = DMenu(I - 1).X + DMenu(I - 1).Width + Espaciado
Else
.X = tLeftMin
End If
Call ExtraerIcono("shell32.dll", I + 22, Icono, ByVal 0&, 1)
Call DibujarIcono(Me.hdc, .X, .Y, Icono, .Width, .Height, 0, 0, &H3)
Call EliminarIcono(Icono)
End With
Next
Me.Refresh
End Sub
'on progress
'Private Function IsItemHover(Item As MenuItem, X As Long, Y As Long) As Boolean
'With Item
' If X >= .X And .X + .Width >= X And .Y <= Y And .Y + .Height >= Y Then
'' IsItemHover = True
' End If
'End With
'End Function
