control windowless qui permet de prendre en charge les evenement mouseout et mouseover
je me suis inspiré des codes de Renfield
http://www.vbfrance.com/codes/CLICK-SUR-CONTROLES-WINDOWLESS-TRANSPARENTS_42562.aspx
http://www.vbfrance.com/codes/TUTORIEL-OCX-BASIQUE_32545.aspx
plus d'info sur les controls masqués:
http://support.microsoft.com/kb/185882/fr
ce code utilise des api windows pour detecter la position de la souris et un timer pour detecter la sortie de la souris.
j'ai essayé avec setcapture sur le control parent . pour l'instant ca ne marche pas tres bien
NB les declaration des api sont dans un module de base
Source / Exemple :
'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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.