Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Type pointapi: X As Long: Y As Long: End Type
Dim pos As pointapi
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
verifPosition CheckBox1
End Sub
Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
verifPosition CheckBox2
End Sub
Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
verifPosition CheckBox3
End Sub
Private Sub commentaire_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'commentaire.Visible = False
End Sub
Sub verifPosition(check As Object)
a = emplacementControl(check)
Dim pos As pointapi
With commentaire:
.Visible = True
.Move check.Left + check.Width, check.top - .Height
If .top < 0 Then .top = 0
If .Left > Me.InsideWidth - .Width Then .Left = Me.InsideWidth - .Width
End With
tim = timer: Do While timer - tim < 0.9: GetCursorPos pos: DoEvents
criter = (pos.X > a(0) And pos.X < a(2))
criter = criter And pos.Y > a(1) 'And pos.Y < a(3)
If criter <> True Then Debug.Print a(0) & " - " & pos.X & " - -" & criter: commentaire.Visible = False: Exit Do
: Loop
End Sub
' fonction du calendar reconvertie
Function emplacementControl(Obj As Object)
If Not Obj Is Nothing Then
Dim Lft As Double, Ltop As Double, P As Object, PInsWidth As Double, PInsHeight As Double
Dim K As Double
Lft = Obj.Left: Ltop = Obj.top: Set P = Obj.Parent ' Normalement Page, Frame ou UserForm
ppx = 0.75
Do
PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight ' Le Page en est pourvu, mais pas le Multipage.
If TypeOf P Is MSForms.Page Then Set P = P.Parent ' Prend le Multipage, car le Page est sans positionnement.
K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): Ltop = (Ltop + P.top + P.Height - K - PInsHeight)
If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
Set P = P.Parent
Loop
a = Array(Lft / ppx, Ltop / ppx, (Lft + Obj.Width) / ppx, (Ltop + Obj.Height) * ppx)
emplacementControl = a
End If
End Function