http://msdn.microsoft.com/en-us/library/ms645536%28v=vs.85%29.aspx
Primero empezamos con el código del modulo:
' Standardmodul Module1
Option Explicit
Public counter As Integer
'Set you Keyboard HID whit VendorID and ProductID
Public Const Device_Name = "VID_04B4&PID_0168"
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
Public Enum DeviceInfoTypes
RIDI_PREPARSEDDATA = &H20000005
RIDI_DEVICENAME = &H20000007
RIDI_DEVICEINFO = &H2000000B
End Enum
'UINT GetRawInputDeviceInfo(
' HANDLE hDevice,
' UINT uiCommand,
' LPVOID pData,
' PUINT pcbSize
');
Private Declare Function GetRawInputDeviceInfo Lib "user32.dll" Alias "GetRawInputDeviceInfoA" ( _
ByVal hDevice As Long, _
ByVal uiCommand As DeviceInfoTypes, _
ByRef pData As Any, _
ByRef pcbSize As Long) As Long
Private Const RIM_TYPEMOUSE = &H0&
Private Const RIM_TYPEKEYBOARD = &H1&
Private Const RID_INPUT = &H10000003
Private Const WM_INPUT = &HFF&
Private Const GWL_WNDPROC = -4&
Private Const RIDEV_INPUTSINK = &H100
'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 tagRAWKEYBOARD {
' USHORT MakeCode;
' USHORT Flags;
' USHORT Reserved;
' USHORT VKey;
' UINT Message;
' ULONG ExtraInformation;
'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;
Private Type RAWKEYBOARD
MakeCode As Integer
Flags As Integer
Reserved As Integer
VKey As Integer
Message As Long
ExtraInformation 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
data As RAWKEYBOARD
End Type
Dim PrevWndProc As Long, mWnd As Long, txtBox As TextBox
Public Sub Init(ByVal hwnd As Long, ByVal text As TextBox)
mWnd = hwnd
Set txtBox = text
PrevWndProc = SetWindowLong(mWnd, GWL_WNDPROC, AddressOf MainWndProc)
InitRawInput mWnd
End Sub
Public Sub Terminate()
Call SetWindowLong(mWnd, GWL_WNDPROC, PrevWndProc)
End Sub
Public Sub InitRawInput(hwnd As Long)
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 = &H6
RID(0).dwFlags = RIDEV_INPUTSINK
RID(0).hwnd = hwnd
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 uniqueParaml As Long
Dim tmpx As Long, tmpy As Long
Dim raw As RAWINPUT
Dim lpb() As Byte
Dim dwSize As Long
If uMsg = WM_INPUT Then
counter = counter + 1
If (counter > 1) 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))
Dim pcbSize As Long
Dim pData() As Byte
Dim i As Integer
Dim name As String
'Inicialize get Device Info
Call GetRawInputDeviceInfo(raw.header.hDevice, RIDI_DEVICENAME, ByVal 0&, pcbSize)
If (pcbSize > 0) Then
ReDim pData(pcbSize - 1)
Call GetRawInputDeviceInfo(raw.header.hDevice, RIDI_DEVICENAME, pData(0), pcbSize)
'Get Name of Device
For i = 1 To (pcbSize - 1) Step 1
If (pData(i) <> 0) Then
name = name & Chr(pData(i))
End If
Next i
End If
Dim array_device_name() As String
array_device_name = Split(name, "#")
If (array_device_name(1) = Device_Name) Then
If raw.header.dwType = RIM_TYPEKEYBOARD Then
txtBox.text = txtBox.text + Chr(raw.data.VKey)
End If
End If
counter = 0
End If
End If
MainWndProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam)
End Function
Ahora la programación del formulario
' Formular Form1
Option Explicit
Private Sub Command1_Click()
Unload (Me)
End Sub
Private Sub Form_Load()
Call Module1.Init(Me.hwnd, Text1)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Module1.Terminate
End Sub
Debo terminar el POST con el respectivo agradecimiento a la web:
http://foren.activevb.de/cgi-bin/foren/archivview.pl?forum=4&msg=381172&root=380881&page=1
La cual es la base de este código con las modificaciones para que lea un teclado la implementación inicial es para habilitar múltiples mouse.
No hay comentarios:
Publicar un comentario