|
|
|
|
|
Code des Moduls modSync aus ControlSyncTest
Private Const MK_LBUTTON = &H1
Private Const MK_RBUTTON = &H2
Private Const MK_SHIFT = &H4
Private Const MK_CONTROL = &H8
Private Const MK_MBUTTON = &H10
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
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
Public Const WM_KEYDOWN = &H100
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Sub MouseDown(hWnd As Long, ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SendMessage CLng(hWnd), zMakeMsg(Button, True), _
zMakeWParam(Button, Shift), zMakeLParam(X, Y)
End Sub
Public Sub MouseMove(hWnd As Long, ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SendMessage CLng(hWnd), WM_MOUSEMOVE, zMakeWParam(Button, _
Shift), zMakeLParam(X, Y)
End Sub
Public Sub MouseUp(hWnd As Long, ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SendMessage CLng(hWnd), zMakeMsg(Button, False), _
zMakeWParam(Button, Shift), zMakeLParam(X, Y)
End Sub
Private Function zMakeLParam(ByVal iX As Single, _
ByVal iY As Single) As Long
zMakeLParam = (CLng(iX) \ Screen.TwipsPerPixelX) + _
(CLng(iY) \ Screen.TwipsPerPixelY) * &H10000
End Function
Private Function zMakeWParam(ByVal iButton As Integer, _
ByVal iShift As Integer) As Long
Dim wParam As Long
If (iButton And vbLeftButton) = vbLeftButton Then
wParam = MK_LBUTTON
End If
If (iButton And vbRightButton) = vbRightButton Then
wParam = wParam Or MK_RBUTTON
End If
If (iButton And vbMiddleButton) = vbMiddleButton Then
wParam = wParam Or MK_MBUTTON
End If
If (iShift And vbCtrlMask) = vbCtrlMask Then
wParam = wParam Or MK_CONTROL
End If
If (iShift And vbShiftMask) = vbShiftMask Then
wParam = wParam Or MK_SHIFT
End If
zMakeWParam = wParam
End Function
Private Function zMakeMsg(ByVal iButton As Integer, _
ByVal iDown As Boolean) As Long
Select Case iDown
Case True
Select Case iButton
Case vbLeftButton
zMakeMsg = WM_LBUTTONDOWN
Case vbRightButton
zMakeMsg = WM_RBUTTONDOWN
Case vbMiddleButton
zMakeMsg = WM_MBUTTONDOWN
End Select
Case False
Select Case iButton
Case vbLeftButton
zMakeMsg = WM_LBUTTONUP
Case vbRightButton
zMakeMsg = WM_RBUTTONUP
Case vbMiddleButton
zMakeMsg = WM_MBUTTONUP
End Select
End Select
End Function
|
|
|