Các kỹ thuật MouseMove

[truongphu]

Thủ thuật: Các kỹ thuật MouseMove
Tác giả: Sưu tầm
Mô tả: Các kỹ thuật MouseMove

---

đây là bài tôi sưu tầm đã lâu, các bạn có thể tham khảo và edit lại phù hợp nhu cầu mình

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

1. Option Explicit
2.  Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
3. ' ----------------------------------------------
4. ' *        MouseEvent Related Declares         *
5. ' ----------------------------------------------
6. Private Const MOUSEEVENTF_ABSOLUTE = &H8000
7. Private Const MOUSEEVENTF_LEFTDOWN = &H2
8. Private Const MOUSEEVENTF_LEFTUP = &H4
9. Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
10. Private Const MOUSEEVENTF_MIDDLEUP = &H40
11. Private Const MOUSEEVENTF_MOVE = &H1
12. Private Const MOUSEEVENTF_RIGHTDOWN = &H8
13. Private Const MOUSEEVENTF_RIGHTUP = &H10
14. Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
15.     ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, _
16.     ByVal dwExtraInfo As Long)
17. ' ----------------------------------------------
18. ' *     GetSystemMetrics Related Declares      *
19. ' ----------------------------------------------
20. Private Const SM_CXSCREEN = 0
21. Private Const SM_CYSCREEN = 1
22. Private Const TWIPS_PER_INCH = 1440
23. Private Const POINTS_PER_INCH = 72
24. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex _
25.     As Long) As Long
26. ' ----------------------------------------------
27. ' *       GetWindowRect Related Declares       *
28. ' ----------------------------------------------
29. Private Type RECT
30.         Left As Long
31.         Top As Long
32.         Right As Long
33.         Bottom As Long
34. End Type
35. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
36.     lpRect As RECT) As Long
37. ' ----------------------------------------------
38. ' *       Internal Constants and Types         *
39. ' ----------------------------------------------
40. Private Const MOUSE_MICKEYS = 65535
41.  
42. Public Enum enReportStyle
43.     rsPixels
44.     rsTwips
45.     rsInches
46.     rsPoints
47. End Enum
48.  
49. Public Enum enButtonToClick
50.     btcLeft
51.     btcRight
52.     btcMiddle
53. End Enum
54. ' Returns the screen size in pixels or, optionally,
55. ' in others scalemode styles
56. Public Sub GetScreenRes(ByRef X As Long, ByRef Y As Long, Optional ByVal _
57.     ReportStyle As enReportStyle)
58.  
59.     X = GetSystemMetrics(SM_CXSCREEN)
60.     Y = GetSystemMetrics(SM_CYSCREEN)
61.     If Not IsMissing(ReportStyle) Then
62.          If ReportStyle <> rsPixels Then
63.             X = X * Screen.TwipsPerPixelX
64.             Y = Y * Screen.TwipsPerPixelY
65.             If ReportStyle = rsInches Or ReportStyle = rsPoints Then
66.                 X = X \ TWIPS_PER_INCH
67.                 Y = Y \ TWIPS_PER_INCH
68.                 If ReportStyle = rsPoints Then
69.                     X = X * POINTS_PER_INCH
70.                     Y = Y * POINTS_PER_INCH
71.                 End If
72.             End If
73.         End If
74.     End If
75. End Sub
76.  
77. ' Convert's the mouses coordinate system to
78. ' a pixel position.
79. Public Function MickeyXToPixel(ByVal mouseX As Long) As Long
80.     Dim X As Long
81.     Dim Y As Long
82.     Dim tX As Single
83.     Dim tmouseX As Single
84.     Dim tMickeys As Single
85.    
86.     GetScreenRes X, Y
87.     tX = X
88.     tMickeys = MOUSE_MICKEYS
89.     tmouseX = mouseX
90.    
91.     MickeyXToPixel = CLng(tmouseX / (tMickeys / tX))
92.    
93. End Function
94.  
95. ' Converts mouse Y coordinates to pixels
96. Public Function MickeyYToPixel(ByVal mouseY As Long) As Long
97.     Dim X As Long
98.     Dim Y As Long
99.     Dim tY As Single
100.     Dim tmouseY As Single
101.     Dim tMickeys As Single
102.    
103.     GetScreenRes X, Y
104.     tY = Y
105.     tMickeys = MOUSE_MICKEYS
106.     tmouseY = mouseY
107.    
108.     MickeyYToPixel = CLng(tmouseY / (tMickeys / tY))
109.    
110. End Function
111.  
112. ' Converts pixel X coordinates to mickeys
113. Public Function PixelXToMickey(ByVal pixX As Long) As Long
114.     Dim X&, Y&
115.     Dim tX As Single
116.     Dim tpixX As Single
117.     Dim tMickeys As Single
118.    
119.     GetScreenRes X, Y
120.     tMickeys = MOUSE_MICKEYS
121.     tX = X
122.     tpixX = pixX
123.    
124.     PixelXToMickey = CLng((tMickeys / tX) * tpixX)
125.  
126. End Function
127.  
128. ' Converts pixel Y coordinates to mickeys
129. Public Function PixelYToMickey(ByVal pixY As Long) As Long
130.     Dim X As Long
131.     Dim Y As Long
132.     Dim tY As Single
133.     Dim tpixY As Single
134.     Dim tMickeys As Single
135.    
136.     GetScreenRes X, Y
137.     tMickeys = MOUSE_MICKEYS
138.     tY = Y
139.     tpixY = pixY
140.    
141.     PixelYToMickey = CLng((tMickeys / tY) * tpixY)
142.  
143. End Function
144. ' The function will center the mouse on a window
145. ' or control with an hWnd property.  No checking
146. ' is done to ensure that the window is not obscured
147. ' or not minimized, however it does make sure that
148. ' the target is within the boundaries of the
149. ' screen.
150. Public Function CenterMouseOn(ByVal hwnd As Long) As Boolean
151.     Dim X As Long
152.     Dim Y As Long
153.     Dim maxX As Long
154.     Dim maxY As Long
155.     Dim crect As RECT
156.     Dim rc As Long
157.  
158.     GetScreenRes maxX, maxY
159.     rc = GetWindowRect(hwnd, crect)
160.    
161.     If rc Then
162.         X = crect.Left + ((crect.Right - crect.Left) / 2)
163.         Y = crect.Top + ((crect.Bottom - crect.Top) / 2)
164.         If (X >= 0 And X <= maxX) And (Y >= 0 And Y <= maxY) Then
165.             MouseMove X, Y
166.             CenterMouseOn = True
167.         Else
168.             CenterMouseOn = False
169.         End If
170.     Else
171.         CenterMouseOn = False
172.     End If
173. End Function
174.  
175. ' Simulates a mouse click
176. Public Function MouseFullClick(ByVal MBClick As enButtonToClick) As Boolean
177.     Dim cbuttons As Long
178.     Dim dwExtraInfo As Long
179.     Dim mevent As Long
180.    
181.     Select Case MBClick
182.         Case btcLeft
183.             mevent = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
184.         Case btcRight
185.             mevent = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP
186.         Case btcMiddle
187.             mevent = MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP
188.         Case Else
189.             MouseFullClick = False
190.             Exit Function
191.     End Select
192.     mouse_event mevent, 0&, 0&, cbuttons, dwExtraInfo
193.     MouseFullClick = True
194.    
195. End Function
196.  
197. Public Sub MouseMove(ByRef xPixel As Long, ByRef yPixel As Long)
198.     Dim cbuttons As Long:     Dim dwExtraInfo As Long
199.    
200.     mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, _
201.         PixelXToMickey(xPixel), PixelYToMickey(yPixel), cbuttons, dwExtraInfo
202. End Sub
203.  

GeSHi © Codebox Plus

[dacluyen]

Anh TruongPhu cho em hỏi chút với ạ. Project của em có một image, form em làm trong suốt nên chỉ có image hiện lên thôi, giờ em đang dùng mousemove để bắt sự kiện con trỏ rê đến image, nhưng em đang muốn bắt thêm cả sự kiện con trỏ rê ra khỏi image thì làm như nào ạ, điều kiện là ko dùng thêm control gì nữa anh nhé, anh chỉ giúp em với ạ. Em xin cảm ơn !