1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
|
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SetCursorPos Lib "user32" ( _
ByVal X As Long, ByVal Y As Long) As Long
Dim X As Long, Y As Long
' Retourne la position de la souris sur l'écran
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' Coordonnées d'un point de l'écran
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const MK_LBUTTON = &H1
Private Const WM_LBUTTONDOWN = &H201
Dim nMousePosition As Long
Private Sub Form_Load()
'Position de la souris
X = 10
Y = 10
' Cet appel de fonction placera le pointeur de la souris au
' coordonnées indiquées dans les zones de texte
Call SetCursorPos(X, Y)
End Sub
'Pour déplacer sa souris sur l'écran
Private Sub Form_KeyPress(KeyAscii As Integer)
'---Déclaration des variables---
Dim Coord As POINTAPI
'---Affiche les coordonnées du curseur de la souris---
GetCursorPos Coord
'Me.Caption = "Bouton gauche de la souris enfoncé : x = " & _
Coord.x & " , y = " & Coord.y
Select Case KeyAscii
Case Is = 52
'MsgBox "gauche"
Coord.X = Coord.X - 10
Call SetCursorPos(Coord.X, Coord.Y)
Case Is = 54
'MsgBox "Droite"
Coord.X = Coord.X + 10
Call SetCursorPos(Coord.X, Coord.Y)
Case Is = 56
'MsgBox "haut"
Coord.Y = Coord.Y - 10
Call SetCursorPos(Coord.X, Coord.Y)
Case Is = 50
'MsgBox "Bas"
Coord.Y = Coord.Y + 10
Call SetCursorPos(Coord.X, Coord.Y)
Case Is = 53
'MsgBox "Clic"
Text1.Text = CInt(Coord.X) & "/" & CInt(Coord.Y)
Coord.X = LoWord(Coord.X)
Coord.Y = HiWord(Coord.Y)
Let nMousePosition = MakeDWord(CInt(Coord.X), CInt(Coord.Y))
Call SendMessage(Me.hwnd, WM_LBUTTONDOWN, MK_LBUTTON, _
nMousePosition)
End Select
End Sub
Function MakeDWord(LoWord As Integer, HiWord As Integer) As Long
MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function
Function LoWord(DWord As Long) As Integer
If DWord And &H8000& Then ' &H8000& = &H00008000
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Function
Function HiWord(DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ &H10000
End Function
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox "ça marche. Ce message est affiché lorsque l'événement Form_MouseDown est appelé."
End Sub |
Partager