POR QUE TRAVA?

GRATRIX 11/07/2013 18:18:55
#425923

Presciso reconhcer 2 mouse no pc identificar de qual ação é de cada um
achei este exeplo na net mais não conse muita coisa ...
alguem pode me ajudar

[ô] Standardmodul Module1
Option Explicit

Private Declare Function SetWindowLong Lib [Ô]user32[Ô] _
Alias [Ô]SetWindowLongA[Ô] ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib [Ô]user32[Ô] _
Alias [Ô]CallWindowProcA[Ô] ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Declare Function SetClipboardViewer Lib [Ô]user32[Ô] ( _
ByVal hWnd As Long) As Long

Private Declare Sub CopyMemory Lib [Ô]kernel32.dll[Ô] Alias [Ô]RtlMoveMemory[Ô] ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal ByteLen As Long)

[ô]UINT GetRawInputDeviceList(
[ô] PRAWINPUTDEVICELIST pRawInputDeviceList,
[ô] PUINT puiNumDevices,
[ô] UINT cbSize
[ô]);
Private Declare Function GetRawInputDeviceList Lib [Ô]user32.dll[Ô] ( _
ByRef pRawInputDeviceList As Any, _
ByRef puiNumDevices As Any, _
ByVal cbSize As Long) As Long

[ô]BOOL RegisterRawInputDevices(
[ô] PCRAWINPUTDEVICE pRawInputDevices,
[ô] UINT uiNumDevices,
[ô] UINT cbSize
[ô]);
Private Declare Function RegisterRawInputDevices Lib [Ô]user32.dll[Ô] ( _
ByRef pRawInputDevices As RAWINPUTDEVICE, _
ByVal uiNumDevices As Long, _
ByVal cbSize As Long) As Long

[ô]UINT GetRawInputData(
[ô] HRAWINPUT hRawInput,
[ô] UINT uiCommand,
[ô] LPVOID pData,
[ô] PUINT pcbSize,
[ô] UINT cbSizeHeader
[ô]);
Private Declare Function GetRawInputData Lib [Ô]user32.dll[Ô] ( _
ByVal hRawInput As Long, _
ByVal uiCommand As Long, _
ByRef pData As Any, _
ByRef pcbSize As Long, _
ByVal cbSizeHeader As Long) As Long

Private Const RIM_TYPEMOUSE = &H0&
Private Const RID_INPUT = &H10000003
Private Const WM_INPUT = &HFF&
Private Const GWL_WNDPROC = -4&

[ô]typedef struct tagRAWINPUTDEVICE {
[ô] USHORT usUsagePage;
[ô] USHORT usUsage;
[ô] DWORD dwFlags;
[ô] HWND hwndTarget;
[ô]} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;
Private Type RAWINPUTDEVICE
usUsagePage As Integer
usUsage As Integer
dwFlags As Long
hWnd As Long
End Type

[ô]typedef struct tagRAWINPUTDEVICELIST {
[ô] HANDLE hDevice;
[ô] DWORD dwType;
[ô]} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;
Private Type RAWINPUTDEVICELIST
hDevice As Long
dwType As Long
End Type

[ô]typedef struct tagRAWINPUTHEADER {
[ô] DWORD dwType;
[ô] DWORD dwSize;
[ô] HANDLE hDevice;
[ô] WPARAM wParam;
[ô]} RAWINPUTHEADER, *PRAWINPUTHEADER;
Private Type RAWINPUTHEADER
dwType As Long
dwSize As Long
hDevice As Long
wParam As Long
End Type

[ô]typedef struct tagRAWMOUSE {
[ô] USHORT usFlags;
[ô] union {
[ô] ULONG ulButtons;
[ô] struct {
[ô] USHORT usButtonFlags;
[ô] USHORT usButtonData;
[ô] };
[ô] };
[ô] ULONG ulRawButtons;
[ô] LONG lLastX;
[ô] LONG lLastY;
[ô] ULONG ulExtraInformation;
[ô]} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;
Private Type RAWMOUSE
usFlags As Integer
ulButtons As Long
ulRawButtons As Long
lLastX As Long
lLastY As Long
ulExtraInformation As Long
End Type

[ô]typedef struct tagRAWINPUT {
[ô] RAWINPUTHEADER header;
[ô] union {
[ô] RAWMOUSE mouse;
[ô] RAWKEYBOARD keyboard;
[ô] RAWHID hid;
[ô] } data;
[ô]} RAWINPUT, *PRAWINPUT; *LPRAWINPUT;
Private Type RAWINPUT
header As RAWINPUTHEADER
data As RAWMOUSE
End Type

Dim PrevWndProc As Long, mWnd As Long

Public Sub Init(ByVal hWnd As Long)
mWnd = hWnd
PrevWndProc = SetWindowLong(mWnd, GWL_WNDPROC, AddressOf MainWndProc)
Call InitRawInput
End Sub

Public Sub Terminate()
Call SetWindowLong(mWnd, GWL_WNDPROC, PrevWndProc)
End Sub

Public Sub InitRawInput()
Dim RID(49) As RAWINPUTDEVICE

Dim nDevices As Long
Dim pRawInputDeviceList() As RAWINPUTDEVICELIST
ReDim pRawInputDeviceList(0)

If GetRawInputDeviceList(ByVal 0&, nDevices, Len(pRawInputDeviceList(0))) <> 0 Then
Exit Sub
End If

ReDim pRawInputDeviceList(nDevices - 1)
Call GetRawInputDeviceList(pRawInputDeviceList(0), nDevices, Len(pRawInputDeviceList(1)))
Debug.Print [Ô]Number of raw input devices: [Ô] & CStr(nDevices)

Erase pRawInputDeviceList

RID(0).usUsagePage = &H1
RID(0).usUsage = &H2
RID(0).dwFlags = &H0
RID(0).hWnd = &H0

If RegisterRawInputDevices(RID(0), 1, Len(RID(0))) = 0 Then
Debug.Print ([Ô]RawInput init failed.[Ô])
End If
End Sub

Public Function MainWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static maxx As Long
Dim tmpx As Long, tmpy As Long
Dim raw As RAWINPUT
Dim lpb() As Byte
Dim dwSize As Long

[ô]Call wsprintf([Ô]hwnd={0}
uMsg={1}
wParam={2}
lParam={3}[Ô], hWnd, uMsg, wParam, lParam)

If uMsg = WM_INPUT Then
Call GetRawInputData(lParam, RID_INPUT, ByVal 0&, dwSize, Len(raw.header))
ReDim lpb(dwSize - 1)

If GetRawInputData(lParam, RID_INPUT, lpb(0), dwSize, Len(raw.header)) <> dwSize Then
Debug.Print [Ô]GetRawInputData doesn[ô]t return correct size![Ô]
End If

Call CopyMemory(raw, lpb(0), Len(raw))

If raw.header.dwType = RIM_TYPEMOUSE Then
tmpx = raw.data.lLastX
tmpy = raw.data.lLastY

maxx = tmpx

Call wsprintf([Ô]Mouse:hDevice {0}
[Ô] & _
[Ô]usFlags={1}
[Ô] & _
[Ô]ulButtons={2}
[Ô] & _
[Ô]ulRawButtuns={5}
[Ô] & _
[Ô]lLastX={6}
[Ô] & _
[Ô]lLastY={7}
[Ô] & _
[Ô]ulExtraInformation={8}
[Ô] & _
[Ô]maxx={9}[Ô], _
raw.header.hDevice, _
raw.data.usFlags, _
raw.data.ulButtons, _
raw.data.ulRawButtons, _
tmpx, _
tmpy, _
raw.data.ulExtraInformation, _
maxx)
End If
End If

MainWndProc = CallWindowProc(PrevWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Sub wsprintf(ByVal Expression As String, ParamArray Values() As Variant)
Dim tmpStr As String: tmpStr = Expression
Dim n As Long

For n = 0 To UBound(Values)
tmpStr = Replace(tmpStr, [Ô]{[Ô] & CStr(n) & [Ô]}[Ô], CStr(Values(n)))
Next n

tmpStr = Replace(tmpStr, [Ô]
[Ô], vbCrLf)

[ô] Ausgabe der Nachricht ans Zielgerät (Debugfenster)
Debug.Print tmpStr
End Sub

[ô] Formular Form1
Option Explicit

Private Sub Form_Click()
Call Module1.Init(Me.hWnd)
End Sub

Private Sub Form_Load()
Call MsgBox(CStr(Me.hWnd))
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Module1.Terminate
End Sub