Dock Menu Source

[xmbeat]

Este es un code que andaba haciendo para hacer un widget pero lamentablemente el tiempo que dispongo no es mucho (entre mi escuela y el trabajo, que bueno que salgo de vacaciones pronto) asi que no he podido terminarlo, pero en cuestion de logica matematica creo que si anda, lo pongo por si alguien se anima a terminarlo.

Código: [Seleccionar]

Private Declare Function ExtraerIcono Lib "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 DibujarIcono Lib "user32" Alias "DrawIconEx" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw 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