MOUSEOUT ET MOUSEOVER SUR LES CONTROLES WINDOWLESS TRANSPARENTS

'Control masqué qui repond aux evenement mouseout et mouseover
'-------------------------------------------------------------

'.windowless=true
'.backstyele=0
'.backcolor=&H000000FF&
'.maskcolor=&H000000FF&
'.scalemode=vbpixels
Option Explicit

Private Over As Boolean 'flag permet de ne pas repercuter l'evenement plusieur fois

Public Event Click()
Public Event MouseOver()
Public Event MouseOut()

'## Evenement Timer
'permet de verifier à interval la position de la souris par rapport au control
Private Sub Timer1_Timer()
    Dim PT As POINTAPI 'coordonées X,Y de la souris en pixel
    Dim h As Long 'handle de la fenetre parent
    Dim left As Long, right As Long, top As Long, bottom As Long   ' position du control en pixel
    Dim rc As RECT
    GetCursorPos PT 'renvoi la position de la souris par rapport à l'ecran
    h = WindowFromPoint(PT.X, PT.Y) ' renvoie le handle du conteneur lorsque le control est windowless
    
    ScreenToClient h, PT 'convertie la position de la souris par rapport au conteneur
    
    
    'position du control par rapport au conteneur en pixel
    'note: le conteneur doit exposé une propriete ScaleMode
    left = UserControl.ScaleX(UserControl.Extender.left, Parent.ScaleMode, vbPixels) 'position gauche en pixel
    right = left + UserControl.ScaleHeight 'position  droite en pixel
    top = UserControl.ScaleY(UserControl.Extender.top, Parent.ScaleMode, vbPixels) ' position haut en pixel
    bottom = top + UserControl.ScaleHeight 'position bas en pixel
       
    If PT.X < left Or PT.X > right Or PT.Y < top Or PT.Y > bottom Then 'compare les coordonnée de la souris à la position du control
        UserControl.BackStyle = 0
        RaiseEvent MouseOut 'la souris est sorie
        Timer1.Interval = 0 ' desactive le timer
        Over = False 'met à jour le flag
    End If
    
End Sub

'## Evenement UserControl

Private Sub UserControl_Initialize()
Over = False 'initialise le flag
End Sub

'Se produit dans un contrôle utilisateur sans fenêtre en réponse à l'activité de la souris.
Private Sub UserControl_HitTest(X As Single, Y As Single, HitResult As Integer)
    HitResult = vbHitResultHit ' demande au programme de repondre à l'activité de la souris
                               ' plus d'info HitResultConstants dans l'explorateur d'objet
End Sub

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Over Then
    UserControl.BackStyle = 1
    RaiseEvent MouseOver
    Over = True    'la souris est entrée
    Timer1.Interval = 5 'active le  timer . control de la position de la souris toute les 5ms
End If

End Sub

Private Sub UserControl_Show()
    If Ambient.UserMode Then
        UserControl.BackStyle = 0 'transparent en mode execution
    Else
        UserControl.BackStyle = 1 'opaque en mode création
    End If


End Sub

Télécharger le zip

10 octobre 2008 22:08:51 :

rectification de la description

11 octobre 2008 13:35:06 :

correction des bogues dus au scalemode le conteneur du control Hidden doit exposé une proprité scalemode