Mouse_Module
Amjad Moustafa :: VB6 :: Modules
صفحة 1 من اصل 1
Mouse_Module
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer)
Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
'Mouse On color
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
'
Private Type POINTAPI
x As Long
y As Long
End Type
Function GetMouseX() As Long
Dim pa As POINTAPI
If GetCursorPos(pa) = 0 Then
' Insert Error Handling code here
End If
GetMouseX = pa.x
End Function
Function GetMouseY() As Long
Dim pa As POINTAPI
If GetCursorPos(pa) = 0 Then
' Insert Error Handling code here
End If
GetMouseY = pa.y
End Function
Function MoveMouse(x As Integer, y As Integer)
SetCursorPos x, y
End Function
Function ClickMouseButton(intButton As Integer)
Select Case intButton
Case 1
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case 3
mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
Case 2
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Select
End Function
Function LeftButton() As Boolean
LeftButton = (GetAsyncKeyState(vbKeyLButton) And &H8000)
End Function
Function RightButton() As Boolean
RightButton = (GetAsyncKeyState(vbKeyRButton) And &H8000)
End Function
Function MiddleButton() As Boolean
MiddleButton = (GetAsyncKeyState(vbKeyMButton) And &H8000)
End Function
Function MouseButton() As Integer
If GetAsyncKeyState(vbKeyLButton) < 0 Then
MouseButton = 1
End If
If GetAsyncKeyState(vbKeyRButton) < 0 Then
MouseButton = MouseButton Or 2
End If
If GetAsyncKeyState(vbKeyMButton) < 0 Then
MouseButton = MouseButton Or 4
End If
End Function
Function Show_Mouse()
Dim f As Long
f = ShowCursor(True)
End Function
Function Hide_Mouse()
Dim f As Long
f = ShowCursor(False)
End Function
Function ColorOnMouse() As Long
Dim tPOS As POINTAPI
Dim sTmp As String
Dim lColor As Long
Dim lDC As Long
'
lDC = GetWindowDC(0)
Call GetCursorPos(tPOS)
lColor = GetPixel(lDC, tPOS.x, tPOS.y)
ColorOnMouse = lColor
End Function
'
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer)
Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
'Mouse On color
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
'
Private Type POINTAPI
x As Long
y As Long
End Type
Function GetMouseX() As Long
Dim pa As POINTAPI
If GetCursorPos(pa) = 0 Then
' Insert Error Handling code here
End If
GetMouseX = pa.x
End Function
Function GetMouseY() As Long
Dim pa As POINTAPI
If GetCursorPos(pa) = 0 Then
' Insert Error Handling code here
End If
GetMouseY = pa.y
End Function
Function MoveMouse(x As Integer, y As Integer)
SetCursorPos x, y
End Function
Function ClickMouseButton(intButton As Integer)
Select Case intButton
Case 1
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case 3
mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
Case 2
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Select
End Function
Function LeftButton() As Boolean
LeftButton = (GetAsyncKeyState(vbKeyLButton) And &H8000)
End Function
Function RightButton() As Boolean
RightButton = (GetAsyncKeyState(vbKeyRButton) And &H8000)
End Function
Function MiddleButton() As Boolean
MiddleButton = (GetAsyncKeyState(vbKeyMButton) And &H8000)
End Function
Function MouseButton() As Integer
If GetAsyncKeyState(vbKeyLButton) < 0 Then
MouseButton = 1
End If
If GetAsyncKeyState(vbKeyRButton) < 0 Then
MouseButton = MouseButton Or 2
End If
If GetAsyncKeyState(vbKeyMButton) < 0 Then
MouseButton = MouseButton Or 4
End If
End Function
Function Show_Mouse()
Dim f As Long
f = ShowCursor(True)
End Function
Function Hide_Mouse()
Dim f As Long
f = ShowCursor(False)
End Function
Function ColorOnMouse() As Long
Dim tPOS As POINTAPI
Dim sTmp As String
Dim lColor As Long
Dim lDC As Long
'
lDC = GetWindowDC(0)
Call GetCursorPos(tPOS)
lColor = GetPixel(lDC, tPOS.x, tPOS.y)
ColorOnMouse = lColor
End Function
Amjad Moustafa :: VB6 :: Modules
صفحة 1 من اصل 1
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى