It is possible to have more than one (at least two) mouse devices connected to a windows10 (maybe so for xp, 7, 8 too) PC at the same time. Any one of which will control the cursor. Is it possible to distinguish between the two in freebasic? My intention is to modify a mouse into a different sort of input device, but I need to discern if it is the modified devices button presses and x/y movements that are taking place. Is there any usb handling within freebasic?
Thanks, any help appreciated.
Yes you can,
Look at GetRawInputData() and GetRawInputDeviceInfo()...
'Extract from José's stuff...
GetRawInputData function uiCommand = RID_HEADER
UNION RAWINPUT_UNION DWORD
mouse AS RAWMOUSE ' RAWMOUSE
keyboard AS RAWKEYBOARD ' RAWKEYBOARD
hid AS RAWHID ' RAWHID
END UNION
UNION RAWINPUT_DATA_UNION DWORD
data AS RAWINPUT_UNION
RAWINPUT_UNION
END UNION
TYPE RAWINPUT DWORD
header AS RAWINPUTHEADER
RAWINPUT_DATA_UNION
END TYPE
GetRawInputDeviceInfo function
hDevice A handle to the raw input device.
uiCommand (RIDI_DEVICENAME RIDI_DEVICEINFO RIDI_PREPARSEDDATA)
The declares and types for FreeBasic are available in winuser.bi, eg.
union tagRAWINPUT_data
mouse as RAWMOUSE
keyboard as RAWKEYBOARD
hid as RAWHID
end union
type tagRAWINPUT
header as RAWINPUTHEADER
data as tagRAWINPUT_data
end type
type RAWINPUT as tagRAWINPUT
type PRAWINPUT as tagRAWINPUT ptr
type LPRAWINPUT as tagRAWINPUT ptr
Thank José, I was lazy, the one I used where from another universe...
[Added] Not to forget GetRawInputDeviceList()
Some keyboard code from the other universe, may be expanded for mouse... (https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55985-raw-keyboard-hid-input-discussion?p=673309#post673309)
Thanks for your suggestions, Jose and Pierre. Unfortunately, I'm not familiar with 'Jose's stuff', and have not got very far in my attempts so far. (at the moment I'm trying to use Paul's winfbe and graphical editor, and I've had to search for winuser.bi (which requires other binary files which I'll have to locate)). I'm guessing that Jose has more** or less put wrappers around the windows api's to enable easier use with Freebasic. Is there any chance, pretty please, that you could write for me, a complete program to, say, read a right button click from a specific mouse. Maybe a big ask, but if you've had a good day..., who knows. Hopefully, then I could discover how to read the other buttons, wheel, coordinates, etc.
At this stage, I'm not even sure how to distinguish between two identical mice . I suppose could plug one in first, or press a sequence of buttons.
I'm thinking it would be better to deal with a lower level of communication, e.g. i/o to the specific usb port, at least for the mouse I'm mechanically messing with. I've had a quick look at this, https://blogs.msdn.microsoft.com/usbcoreblog/2015/07/29/what-is-new-with-serial-in-windows-10/ (https://blogs.msdn.microsoft.com/usbcoreblog/2015/07/29/what-is-new-with-serial-in-windows-10/) which is most likely what I need to get to grips with, but not sure if it will be backwards compatible with w7, say. And it will most likely be difficult for me to get an understanding of it, I am not familiar with using windows api's, and what I've found on the web, and looks easy, https://freebasic.net/forum/viewtopic.php?f=7&t=13451 (https://freebasic.net/forum/viewtopic.php?f=7&t=13451) has been criticized in later posts. Are there any complete and better explained examples?
Best wishes,
Ray
** probably much more than that.
Winuser.bi in no my stuff. It is an include file that comes with the Free Basic compiler.
Hi Ray,
Sadly on my side I don't think I will code around this subject in a near future...
Anyway, thanks for your help, Pierre. I think I'm disappearing down a rabbit hole. :( I thought I'd found a useful example (in html and javascript - but it needs visual studio, the code given will not run otherwise, at least, not for me.
I'm coming to the conclusion that if I want to mess with the mouse, then a serial(RS232) device would be considerably easier for me, having in the past built serial hardware, etc. I have a usb to serial interface/connector lead, and when connected via usb, com ports are assigned, and the stop bits and so on can be set up in windows device manager, or hopefully within fb. It only allows xon/xoff protocol however, but that's OK. The optical usb mouse came with a ps2 connector adapter, and I have ps2 to serial adapters from way back, but I would have to power the mouse separately, because ps2 and usb has power through the connector. Now to rummage through, see if I can find any info on an old serial mouse (genius easymouse 2). Most likely, if I follow this through, eventually I'll be making a device based on a microchip device.
If you are not comfortable with APIs then the GetRawInput*() families, and probably the SetupDI(), will be hard to manage.
Could a JoyStick be used?
Also, have a look at the freeware EitherMouse (https://www.eithermouse.com/), use the zip for a no install standalone.
Thanks Pierre, I'll download the eithermouse sw, see if it can be made to do what I want. The more I think about what I want to do, the more complicated it becomes. I have to somehow get it to interact with some existing Pascal software, for which I may not be able to get the source code. But as I know the author, I may be able to do some horse trading, possibly get him to do the alterations, if needed. fwiw, I found an old serial mouse, but I can't get it to work on my current desktop serial port. I think it used pin1 as a power source, but maybe another, dtr/whatever, to power the mouse chip. I can ring it through to try it out, and if necessary for proof of concept testing, power it externally.
I'm not sure about the serial port you have, maybe it could be that
mice could "steal" +12vdc and -12vdc from original db9/db25 serial port.
USB adapter give only +5vdc, which might be too low
Also I noted on a project I had that when using a USB adapter instead of a genuine serial port
I had to reverse the logic state of all signal.
Aka in my soft, treat positive RTS signal as negative, and so on for all pins.
eithermouse software is written in a scripting language - auto hot key- which until now I've not heard of, but the author includes the source, and encourages? folk to edit it. (another turn off the rabbit hole for me ;)
Still, if it was easy, everyone would be doing it.
From the code, I see that EitherMouse use RawInput functions.
From program I had, Id did a quick test code under PowerBASIC using José's API.
I use some SetupDi functions to get connected mice info.
This is done via GetDeviceInfo("Mouse") function.
Compare HardId to MID$(DeviceName, 5, LEN(HardId)) (Convert # to _) to get the corresponding RawDevice if needed.
Then I call some RawInput functions to get mouse's stuff.
I'm sure you'll get the idea.
Code work mainly on mouse click.
I do not have time for now to translate to FB, plus, a lot of cleanup is needed but maybe in a week or so, maybe...
Code updated to fb, 2018-09-26
Part one:
#Define JumpCmd "<Show Info>" ''To save time, PreCompilerOption must be beFORe "CompilerExe" Or "CompilerCmd" If Any
#Define JumpCompiler "<D:\Free\64\fbc.exe>" 'Compiler to use "< = left delimiter, >" = right delimiter
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Free\bas\~~Default.rc">" 'Command line to sEnd to compiler (gui Or console)
#Lang "fb"
#Define Unicode
#Include Once "windows.bi"
#Include Once "string.bi" 'Format
#Include Once "win\shellapi.bi"
#Include Once "win\SetupApi.bi"
#Define AppName "Raw mouse"
#Define ButtonExit 101
#Define ButtonTextClear 102
#Define Edit 201
#Define LineSeparator String(75, 45)
Const HTab = !"\9"
Const MAX_CLASS_NAME_LEN = 32
Type GlobalType
hEdit As hWnd 'Edit handle
HardId(0 TO 1) As zString * 128 * 2 'From SetupGui
DeviceName(0 TO 1) As zString * 128 * 2 'From Raw
Handle(0 TO 1) As hWnd 'From Raw
'Add more elements if global var is needed
End Type
Dim Shared As GlobalType Pointer g
Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(Null)
'______________________________________________________________________________
Function FieldGet(ByVal sData As String, ByVal sSplit As String, ByVal FieldTarget As Long) As String
Dim ChrPos As Long = 1
Dim SplitPos As Long
Dim FieldIndex As Long
If Len(sData) * Len(sSplit) Then 'Both string lenght must be non zero
Do 'Loop for every field
SplitPos = InStr(ChrPos, sData, sSplit) 'Get split position, use InStr/ANY if needed
FieldIndex += 1 'Increment field count
If FieldIndex = FieldTarget Then 'Wanted field index
If SplitPos = 0 THEN SplitPos = Len(sData) + 1 'Unique or last field
Function = Mid(sData, ChrPos, SplitPos - ChrPos) 'Return data
Exit Do 'Job done
End If
ChrPos = SplitPos + Len(sSplit) 'Prepare for possible next search
Loop While SplitPos 'Done if no more found
End If
End Function
'_____________________________________________________________________________
Function WindowFromPointEx(ByVal CursorPosDesktop As Point) As HANDLE
'Thanks to J. Brown @ http://read.pudn.com/downloads14/sourcecode/windows/system/55084/winspy+SCR/scr/WindowFromPointEx.c__.htm
Dim hFromPoint As HANDLE
Dim hParent As HANDLE
Dim hControlTry As HANDLE
Dim CtrlRect As RECT
Dim Area As Long
Dim AreaPrev As Long
hFromPoint = WindowFromPoint(CursorPosDesktop)
Function = hFromPoint
hParent = GetParent(hFromPoint)
If hParent Then
hControlTry = GetWindow(hParent, GW_CHILD) 'Get first child window
Do While hControlTry 'Enumerate all child including ourselve
GetWindowRect(hControlTry, @CtrlRect) 'Get child's rect
If PtInRect(@CtrlRect, CursorPosDesktop) Then 'Is mouse on control
Area = (CtrlRect.Right - CtrlRect.Left) * (CtrlRect.Bottom - CtrlRect.Top) 'Calculate area
If AreaPrev Then 'This is another control under same mouse position, like FRAME or BUTTON
If Area < AreaPrev Then 'If it's smaller Then we want it
If IsWindowVisible(hControlTry) Then
Function = hControlTry
End If
End If
End If
AreaPrev = Area 'Save value for next loop, if any
End If
hControlTry = GetWindow(hControlTry, GW_HWNDNEXT)
Loop
End If
End Function
'_____________________________________________________________________________
Function WinError(ByVal ErrorCode As DWord) As String
Dim pzError As LPTSTR 'wString Pointer
Dim ErrorLen As DWord
ErrorLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_ALLOCATE_BUFFER, _
Null, ErrorCode, Null, Cast(LPTSTR, @pzError), Null, Null)
If ErrorLen Then
*pzError = rTrim(*pzError, Any wChr(13, 10))
Function = "Error " & ErrorCode & " (0x" & Hex(ErrorCode) & ") : " & *pzError
LocalFree(pzError)
Else
Function = "Unknown error " & ErrorCode & " (0x" & Hex(ErrorCode) & ")"
End If
End Function
'______________________________________________________________________________
Function MouseStateGet(ByVal usFlags As WORD) As String
Dim sState As String
'usFlags Type: USHORT The mouse state. This member can be Any reasonable combination of the following.
If (usFlags AND MOUSE_MOVE_ABSOLUTE) THEN
sState &= "MOUSE_MOVE_ABSOLUTE, " '1 Mouse movement data is based on absolute position.
Else
sState = "MOUSE_MOVE_RELATIVE, " '0 Mouse movement data is relative to the last mouse position.
End If
If (usFlags AND MOUSE_VIRTUAL_DESKTOP) THEN sState &= "MOUSE_VIRTUAL_DESKTOP, " '0x02 Mouse coordinates are mapped to the virtual desktop (FOR a multiple monitor system).
If (usFlags AND MOUSE_ATTRIBUTES_CHANGED) THEN sState &= "MOUSE_ATTRIBUTES_CHANGED, " '0x04 Mouse attributes changed; application needs to query the mouse attributes.
Function = LEFT$(sState, Len(sState) - 2) & " (0x" & Hex(usFlags, 4) & ")"
End Function
'______________________________________________________________________________
Function MouseTransitionStateGet(ByVal usButtonFlags As WORD) As String
Dim sState As String
'usButtonFlags The transition state of the mouse buttons. This member can be one or more of the following values.
'The transition state of the mouse buttons. This member can be one or more of the following values.
If (usButtonFlags AND RI_MOUSE_LEFT_BUTTON_DOWN) THEN sState = "RI_MOUSE_LEFT_BUTTON_DOWN, " '0x0001 Left button changed to down.
If (usButtonFlags AND RI_MOUSE_LEFT_BUTTON_UP) THEN sState &= "RI_MOUSE_LEFT_BUTTON_UP, " '0x0002 Left button changed to up.
If (usButtonFlags AND RI_MOUSE_RIGHT_BUTTON_DOWN) THEN sState &= "RI_MOUSE_RIGHT_BUTTON_DOWN, " '0x0004 Right button changed to down.
If (usButtonFlags AND RI_MOUSE_RIGHT_BUTTON_UP) THEN sState &= "RI_MOUSE_RIGHT_BUTTON_UP, " '0x0008 Right button changed to up.
If (usButtonFlags AND RI_MOUSE_MIDDLE_BUTTON_DOWN) THEN sState &= "RI_MOUSE_MIDDLE_BUTTON_DOWN, " '0x0010 Middle button changed to down.
If (usButtonFlags AND RI_MOUSE_MIDDLE_BUTTON_UP) THEN sState &= "RI_MOUSE_MIDDLE_BUTTON_UP, " '0x0020 Middle button changed to up.
If (usButtonFlags AND RI_MOUSE_BUTTON_4_DOWN) THEN sState &= "RI_MOUSE_BUTTON_4_DOWN, " '0x0040 XBUTTON1 changed to down.
If (usButtonFlags AND RI_MOUSE_BUTTON_4_UP) THEN sState &= "RI_MOUSE_BUTTON_4_UP, " '0x0080 XBUTTON1 changed to up.
If (usButtonFlags AND RI_MOUSE_BUTTON_5_DOWN) THEN sState &= "RI_MOUSE_BUTTON_5_DOWN, " '0x0100 XBUTTON2 changed to down.
If (usButtonFlags AND RI_MOUSE_BUTTON_5_UP) THEN sState &= "RI_MOUSE_BUTTON_5_UP, " '0x0200 XBUTTON2 changed to up.
If (usButtonFlags AND RI_MOUSE_WHEEL) THEN sState &= "RI_MOUSE_WHEEL, " '0x0400 Raw input comes from a mouse wheel. The wheel delta is stored in usButtonData.
Function = LEFT$(sState, Len(sState) - 2) & " (0x" & Hex(usButtonFlags, 4) & ")"
End Function
'______________________________________________________________________________
Sub EditClear()
'Erase all, Microsoft recommEnded way
SendMessage(g->hEdit, WM_SETTEXT, 0, 0)
End Sub
'_____________________________________________________________________________
Sub EditAdd(ByVal psText As wString Pointer) 'TextAdd() keyword
Dim CrLf As wString * 4 = wChr(13, 10)
'Move the caret to the End of text.
SendMessage(g->hEdit, EM_SETSEL, -2, -2)
'Insert the string at caret position.
SendMessage(g->hEdit, EM_REPLACESEL, True, Cast(lParam, psText)) 'True=CanUndo
SendMessage(g->hEdit, EM_SETSEL, -1, -1)
SendMessage(g->hEdit, EM_REPLACESEL, True, Cast(lParam, @CrLf)) 'True=CanUndo
SendMessage(g->hEdit, EM_LINESCROLL, 0, 1)
End Sub
'______________________________________________________________________________
Function SetupDiGetDeviceRegistryPropertyCall(ByVal hDeviceInfoSet As HDEVINFO, ByRef DeviceInfoData As SP_DEVINFO_DATA, _
ByVal PropertyVal As DWord, ByVal sDef As String) As String
Dim zPropertyBuffer As zString * 128 * 2
Dim pz As zString Pointer
Dim sBuf As String
Dim RequiredSize As DWord
Dim PropertyRegDataType As DWord
Dim index As Long
Dim LastError As Long
If SetupDiGetDeviceRegistryPropertyA(hDeviceInfoSet, _ 'Return True If success
@DeviceInfoData, _ 'SP_DEVINFO_DATA var
PropertyVal, _ 'Aka SPDRP_BUSNUMBER, SPDRP_FRIENDLYNAME SPDRP_DEVICEDESC, _ '
@PropertyRegDataType, _ 'Reg type of data received
@zPropertyBuffer, _ 'Data received
SizeOf(zPropertyBuffer), _
@RequiredSize) THEN 'Required size FOR the PropertyBuffer buffer
'REG_NONE = 0 No value type
'REG_SZ = 1 Unicode nul terminated string
'REG_EXPAND_SZ = 2 Unicode nul terminated string
'REG_BINARY = 3 Free FORm binary
'REG_DWord = 4 32-bit number
'REG_DWord_LITTLE_EndIAN = 4 32-bit number (same As MACRO REG_DWord)
'REG_DWord_BIG_EndIAN = 5 32-bit number
'REG_LINK = 6 Symbolic Link (unicode)
'REG_MULTI_SZ = 7 Multiple Unicode strings
'REG_RESOURCE_LIST = 8 Resource list in the resource map
'REG_FULL_RESOURCE_DESCRIPTOR = 9 Resource list in the hardware description
'REG_RESOURCE_REQUIREMENTS_LIST = 10
'REG_QWORD = 11 64-bit number
'REG_QWORD_LITTLE_EndIAN = 11 64-bit number (same As MACRO REG_QWORD)
Select Case PropertyRegDataType
Case REG_SZ '1
'Nothing to Do
Case REG_DWord '4
zPropertyBuffer = "0x" & HEX(CVS(zPropertyBuffer), 8) 'Convert from DWord
Case REG_BINARY '3
FOR index = 1 TO RequiredSize 'Convert from binary
sBuf = sBuf & HEX(ASC(zPropertyBuffer, index), 2) & " "
Next : zPropertyBuffer = sBuf
Case REG_MULTI_SZ '7
pz = @zPropertyBuffer : sBuf = "" 'Convert multi zero terminated string
While Len(*pz)
sBuf = sBuf & "[" & *pz & "]" : pz = pz + Len(*pz)
Wend : zPropertyBuffer = sBuf
Case Else
zPropertyBuffer = "0x" & HEX(CVS(zPropertyBuffer)) 'Convert from DWord
End Select
If PropertyVal = SPDRP_HARDWAREID Then
If Len(g->HardId(0)) Then
g->HardId(1) = zPropertyBuffer
Else
g->HardId(0) = zPropertyBuffer
End If
End If
zPropertyBuffer = sDef & HTab & HTab & zPropertyBuffer
Else
LastError = GetLastError()
zPropertyBuffer = WinError(LastError)
'Returns ERROR_INVALID_DATA If the property does not exist or If the property data is not valid.
If LastError = ERROR_INVALID_DATA THEN zPropertyBuffer = sDef & HTab & "[none] Property might not exist : " & zPropertyBuffer
End If
Function = zPropertyBuffer
End Function
'______________________________________________________________________________
'
Part two:
'______________________________________________________________________________
'
Function GetDeviceInfo(ByRef Device As String) As Long
Dim zClassName As zString * 128
Dim wGuidTxt As wString * 39 'LPOLESTR lpsz
Dim DeviceInfoData As SP_DEVINFO_DATA
Dim hDeviceInfoSet As HDEVINFO
Dim RequiredSize As DWord
Dim DevCount As Long
Dim Retval As Long
zClassName = Device
DevCount = 0
'The SetupDiClassGuidsFromName Function retrieves the GUID(s) associated with the specIfied class name.
'This list is built based on the classes currently installed on the system.
Retval = SetupDiClassGuidsFromName(zClassName, ByVal 0, ByVal 0, @RequiredSize) 'Ask FOR array size, returns TRUE If successful.
EditAdd(" - SetupDi devices")
EditAdd(LineSeparator)
REDIM GuidArray(1 TO RequiredSize) As GUID
Retval = SetupDiClassGuidsFromName(zClassName, @GuidArray(1), _ 'Ask FOR GUID associated with the class name
ByVal SizeOf(GUID) * RequiredSize, @RequiredSize)
'SetupDiGetClassDevs retrieves a device information set that contains all devices of a specIfied class.
'Get info by ClassGUID, like GUID$("{4D36E978E325-11CE-BFC1-08002BE10318})
hDeviceInfoSet = SetupDiGetClassDevs(@GuidArray(1), ByVal Null, ByVal Null, DIGCF_PRESENT)
EditAdd("hDeviceInfoSet: " & HTab & "0x" & Hex(hDeviceInfoSet))
If hDeviceInfoSet <> INVALID_HANDLE_VALUE THEN
DeviceInfoData.cbSize = SizeOf(DeviceInfoData)
Do 'Loop to get all devices of a class
'Get a device based on DevCount, exit If no more
If SetupDiEnumDeviceInfo(hDeviceInfoSet, DevCount, @DeviceInfoData) THEN 'Return True if success
EditAdd(LineSeparator)
EditAdd("ClassName: " & HTab & zClassName)
StringFromGUID2(@GuidArray(1), @wGuidTxt, 38 * 2)
EditAdd("GUID: " & HTab & HTab & wGuidTxt)
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, "FriEndlyName: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, "Desc: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_DRIVER, "Driver: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_HARDWAREID, "HardId: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_ENUMERATOR_NAME, "Enum: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_MFG, "MFG: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_SERVICE, "Servcice: "))
EditAdd(SetupDiGetDeviceRegistryPropertyCall(hDeviceInfoSet, DeviceInfoData, SPDRP_PHYSICAL_DEVICE_OBJECT_NAME, "PhyObj: "))
Function = TRUE
Else
EXIT DO
End If
DevCount += 1
LOOP
SetupDiDestroyDeviceInfoList(hDeviceInfoSet)
End If
EditAdd(LineSeparator)
EditAdd(LineSeparator)
End Function
'______________________________________________________________________________
Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
Static hButtonExit As HWND
Static hButtonTextClear As HWND
Static hFont As HFONT
Select Case (uMsg)
Case WM_CREATE
'Controls creations -----------------------------------------------------
Dim NotClientMetrics As NONCLIENTMETRICS
NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)
g->hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "", _
WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or _
WS_TABSTOP Or WS_VSCROLL Or ES_LEFT Or ES_AUTOHSCROLL Or _
ES_MULTILINE Or ES_WANTRETURN Or ES_NOHIDESEL, _
10, 10, 205, 310, _
hWnd, Cast(HMENU, Edit), _
hInstance, Null)
SendMessage(g->hEdit, WM_SETFONT, Cast(WPARAM, hFont), True)
hButtonTextClear = CreateWindowEx(0, "Button", "Text &clear", _
WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
BS_NOTIfY Or BS_TEXT Or BS_VCENTER, _
10, 325, 95, 30, _
hWnd, Cast(HMENU, ButtonTextClear), _
hInstance, Null)
SendMessage(hButtonTextClear, WM_SETFONT, Cast(WPARAM, hFont), True)
hButtonExit = CreateWindowEx(0, "Button", "E&xit", _
WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
BS_NOTIfY Or BS_TEXT Or BS_VCENTER, _
105, 325, 95, 30, _
hWnd, Cast(HMENU, ButtonExit), _
hInstance, Null)
SendMessage(hButtonExit, WM_SETFONT, Cast(WPARAM, hFont), True)
'Get SetupDi infos -------------------------------------------------------
GetDeviceInfo("Mouse") ' "keyboard/Mouse"
'Get raw input infos -----------------------------------------------------
'The devices returned from this function are the mouse, the keyboard, and other human interface device (HID) devices.
EditAdd("- Raw info")
EditAdd(LineSeparator)
Dim RawInputDevCount As Long
GetRawInputDeviceList(ByVal Null, @RawInputDevCount, SizeOf(RAWINPUTDEVICELIST)) 'Get hid count
EditAdd("Found " & STR(RawInputDevCount) & " raw input devices in total")
Dim RawInputDevList(0 TO RawInputDevCount - 1) As RAWINPUTDEVICELIST 'Prepare hid array
GetRawInputDeviceList(@RawInputDevList(0), @RawInputDevCount, ByVal SizeOf(RAWINPUTDEVICELIST)) 'Get array of all devices
Dim RawInputDev(0 To RawInputDevCount - 1) As RAWINPUTDEVICE 'Prepare hid register array
Dim MouseCount As Long = 0
Dim index As Long
FOR Index = 0 To RawInputDevCount - 1
Dim wDeviceName As wString * 128
Dim RidDeviceInfoSize As DWord = SizeOf(wDeviceName)
GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_DEVICENAME, @wDeviceName, @RidDeviceInfoSize) 'Get hid info
Dim DataSize As Long = 0
Dim RidDeviceInfo As RID_DEVICE_INFO
RidDeviceInfoSize = SizeOf(RID_DEVICE_INFO)
Select Case RawInputDevList(index).dwType '0 = mouse, 1 = keyboard, 2 = other.
Case RIM_TYPEMOUSE
EditAdd("Handle " & wChr(9, 9, 9) & "0x" & Hex(RawInputDevList(index).hDevice, 8))
EditAdd("DeviceType " & wChr(9) & _
FieldGet("RIM_TYPEMOUSE,RIM_TYPEKEYBOARD,RIM_TYPEHID", ",", RawInputDevList(index).dwType + 1))
EditAdd("DeviceName " & wChr(9) & wDeviceName)
Dim indexRef As Long
For indexRef = 0 To 1 'Match SetupDi mouse HardId to Raw DeviceName
If Mid(g->HardId(indexRef), 6, 18) = Mid(wDeviceName, 9, 18) Then
g->DeviceName(indexRef) = wDeviceName
g->Handle(indexRef) = RawInputDevList(index).hDevice
End If
Next
GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_DEVICEINFO, @RidDeviceInfo, @RidDeviceInfoSize)
EditAdd("Mouse id " & wChr(9, 9) & Str(RidDeviceInfo.mouse.dwId))
EditAdd("Mouse button count " & wChr(9) & Str(RidDeviceInfo.mouse.dwNumberOfButtons))
EditAdd("Mouse data points/second " & wChr(9) & Str(RidDeviceInfo.mouse.dwSampleRate))
EditAdd("Mouse has horizontal wheel " & wChr(9) & Str(RidDeviceInfo.mouse.fHasHorizontalWheel))
DataSize = GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_PREPARSEDDATA, Null, @DataSize)
Dim sData As String = String(DataSize, 0)
DataSize = GetRawInputDeviceInfo(RawInputDevList(index).hDevice, RIDI_PREPARSEDDATA, Null, @DataSize)
EditAdd("Preparsed data byte count " & wChr(9) & Str(DataSize))
RawInputDev(MouseCount).usUsagePage = 1
RawInputDev(MouseCount).usUsage = 2
RawInputDev(MouseCount).dwFlags = RIDEV_EXINPUTSINK 'Always capture
RawInputDev(MouseCount).hwndTarget = hWnd
MouseCount += 1
EditAdd(LineSeparator)
Case RIM_TYPEKEYBOARD
Case RIM_TYPEHID 'Not a keyboard, nor a mouse but joystrick, etc...
End Select
Next
EditAdd(LineSeparator)
EditAdd(" - WM_INPUT")
EditAdd(LineSeparator)
'Registers the devices to get WM_INPUT data.
RegisterRawInputDevices(@RawInputDev(0), MouseCount, SizeOf(RAWINPUTDEVICE)) 'Register hids
Case WM_INPUT
STATIC zRawInput As String * 1024 'Faster than building a String every time
Dim pRawInput As RAWINPUT Pointer
Dim ByteCount As Long
Dim ByteCountF As Long
pRawInput = Cast(RAWINPUT Pointer, @zRawInput)
ByteCount = Len(zRawInput)
ByteCountF = GetRawInputData(Cast(HRAWINPUT, LPARAM), RID_INPUT, pRawInput, @ByteCount, SizeOf(RAWINPUTHEADER))'Get hid input
If GetForegroundWindow <> hWnd THEN
If pRawInput->data.mouse.usButtonFlags THEN
EditAdd("RawInput->Header.hDevice = " & HTab & HTab & HEX(pRawInput->header.hDevice, 8))
Dim index As Long
FOR index = 0 TO 1
If g->Handle(index) = pRawInput->header.hDevice Then
EditAdd("Mouse = " & HTab & HTab & HTab & HTab & Str(index))
End If
NEXT
EditAdd("RawInput->Header.dwType = " & HTab & HTab & _
FieldGet("RIM_TYPEMOUSE,RIM_TYPEKEYBOARD,RIM_TYPEHID", ",", pRawInput->header.dwType + 1))
EditAdd("RawInput->Header.wParam = " & HTab & HTab & HEX(pRawInput->header.wParam, 8)) 'The value passed in the wParam parameter of the WM_INPUT message.
EditAdd("RawInput->data.mouse.usFlags = " & HTab & MouseStateGet(pRawInput->data.mouse.usFlags)) '
EditAdd("RawInput->data.mouse.usButtonFlags = " & HTab & MouseTransitionStateGet(pRawInput->data.mouse.usButtonFlags)) '
EditAdd("RawInput->data.mouse.usButtonData = " & HTab & "0x" & HEX(pRawInput->data.mouse.usButtonData, 4)) '
'EditAdd("RawInput->data.mouse.ulRawButtons = " & HTab & Format(pRawInput->data.mouse.ulRawButtons)) 'Reserved
'EditAdd("RawInput->data.mouse.lLastX = " & HTab & Format(pRawInput->data.mouse.lLastX)) 'The motion in the X direction. This is signed relative motion or absolute motion, depEnding on the value of usFlags.
'EditAdd("RawInput->data.mouse.lLastY = " & HTab & Format(pRawInput->data.mouse.lLastY)) 'The motion in the Y direction. This is signed relative motion or absolute motion, depEnding on the value of usFlags.
'EditAdd("RawInput->data.mouse.ulExtraInfo = " & HTab & "0x" & HEX(pRawInput->data.mouse.ulExtrainformation)) '
Dim CurPos As Point
GetCursorPos(@CurPos)
EditAdd("Cursor: " & HTab & HTab & HTab & HTab & Format(CurPos.x) & " x " & Format(CurPos.x))
Dim As hWnd hFromPoint = WindowFromPointEx(CurPos)
Dim As hWnd hFromPointAncestor = GetAncestor(hFromPoint, GA_ROOT)
EditAdd("WindowFromPointEx = " & HTab & HTab & "0x" & HEX(hFromPoint))
Dim zClassName As wString * MAX_CLASS_NAME_LEN
GetClassName(hFromPoint, zClassName, SizeOf(zClassName))
EditAdd("Control className = " & HTab & HTab & zClassName)
Dim zText As String
Dim As Long TextLen = 1 + SendMessage(hFromPoint, WM_GETTEXTLENGTH, 0, 0)
IF TextLen > 1 Then 'We got something
zText = String(TextLen * 2 + 2, 0)
TextLen = Len(zText)
SendMessageA(hFromPoint, WM_GETTEXT, TextLen, Cast(lParam, StrPtr(zText)))
zText = Trim(Left(zText, 50)) '50 is enough
EditAdd("Control text = " & HTab & HTab & HTab & zText)
Else
EditAdd("Control text = " & HTab & HTab & HTab & "[none]")
End If
If hFromPoint <> hFromPointAncestor Then 'Get main window
EditAdd("Ancestor handle = " & HTab & HTab & HTab & "0x" & Hex(hFromPointAncestor))
GetClassName(hFromPointAncestor, zClassName, SizeOf(zClassName))
EditAdd("Ancestor classname = " & HTab & HTab & zClassName)
TextLen = 1 + SendMessage(hFromPointAncestor, WM_GETTEXTLENGTH, 0, 0)
zText = String(TextLen * 2 + 2, 0)
SendMessageA(hFromPointAncestor, WM_GETTEXT, TextLen, Cast(lParam, StrPtr(zText)))
EditAdd("Ancestor caption = " & HTab & HTab & HTab & zText)
End If
EditAdd(LineSeparator)
End If
End If
DefWindowProc(hWnd, uMsg, wParam, lParam) 'ok
Function = 0 : EXIT Function
Case WM_INPUT_DEVICE_CHANGE 'RIDEV_DEVNOTIfY Sent to the window that registered to receive raw input.
'wParam This parameter can be one of the following values.
' GIDC_ARRIVAL 1 A new device has been added to the system.
' GIDC_REMOVAL 2 A device has been removed from the system.
'lParam The handle to the raw input device. Call GetRawInputDeviceInfo to get more information regarding the device.
Case WM_COMMAND
Dim Code As Word = HiWord(wParam)
Dim ControlId As Word = LoWord(wParam)
Select Case ControlId
Case ButtonTextClear
If Code = BN_CLICKED Or Code = 1 Then
EditClear()
EndIf
Case ButtonExit, IDCANCEL
If Code = BN_CLICKED Or Code = 1 Then
Function = ControlId
PostMessage(hWnd, WM_CLOSE, 0, 0)
Exit Function
EndIf
End Select
Case WM_SIZE
If wParam <> SIZE_MINIMIZED Then
Dim As Long SizeX = LOWORD(LPARAM)
Dim As Long SizeY = HIWORD(LPARAM)
MoveWindow(g->hEdit, 10, 10, SizeX - 20, SizeY - 50, True)
MoveWindow(hButtonTextClear, 10, SizeY - 35, SizeX / 2 - 20, 30, True)
MoveWindow(hButtonExit, SizeX / 2 + 10, SizeY - 35, SizeX / 2 - 20, 30, True)
End If
Case WM_DESTROY
DeleteObject(hFont)
PostQuitMessage(0)
Exit Function
End Select
Function = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
'_____________________________________________________________________________
Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
ByVal CmdLine As wString Ptr, ByVal CmdShow As Integer) As UINT
Dim WinClass As WNDCLASS
Dim WindowSize As SIZEL
Dim wsAppName As wString * 128
Dim hWnd As HWND
Dim wMsg As MSG
Dim gVar As GlobalType
g = @gVar
wsAppName = AppName & " - " & SizeOf(UInteger) * 8
WindowSize.cx = 900
WindowSize.cy = 700
WinClass.hIcon = ExtractIcon(hInstance, "%SystemRoot%\system32\shell32.dll", 293)
WinClass.style = CS_HREDRAW Or CS_VREDRAW
WinClass.lpfnWndProc = ProcPtr(WndProc)
WinClass.cbClsExtra = 0
WinClass.cbWndExtra = 0
WinClass.hInstance = hInstance
WinClass.hCursor = LoadCursor(Null, IDC_ARROW)
WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
WinClass.lpszMenuName = Null
WinClass.lpszClassName = @wsAppName
If (RegisterClass(@WinClass)) Then
hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
wsAppName, wsAppName, _
WS_OVERLAPPED Or WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or WS_VISIBLE Or WS_CAPTION Or _
WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SIZEBOX Or WS_SYSMENU , _
(GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosX
(GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosY
WindowSize.cx, WindowSize.cy, _ 'SizeX, SizeY
Null, Null, hInstance, Null)
ShowWindow(hWnd, SW_SHOW)
UpdateWindow(hWnd)
While GetMessage(@wMsg, ByVal Null, 0, 0) > 0
If IsDialogMessage(hWnd, @wMsg) = 0 Then
TranslateMessage(@wMsg)
DispatchMessage(@wMsg)
End If
Wend
End If
DestroyIcon(WinClass.hIcon)
Function = wMsg.message
End Function
'_____________________________________________________________________________
End WinMain(hInstance, Null, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'
Thanks Pierre, for taking an interest. I'll pick over what you have written, see if I can get it to something like it in freebasic. I really appreciate your help.
Best wishes,
Ray
I may have some FB code for you soon...
Later...
Both previous posts
September 24, 2018, 12:30:44 AM (https://www.planetsquires.com/protect/forum/index.php?topic=4226.msg32511#msg32511)
and
September 24, 2018, 12:31:22 AM (https://www.planetsquires.com/protect/forum/index.php?topic=4226.msg32512#msg32512)
have been updated and translated to fb.
Hi Pierre, thanks, I didn't notice you'd converted it to fb, until I got your pm.
The FieldGet() function was a paste from a bad template.
It is now updated in my previous main code post.
It should looks more like this...
'______________________________________________________________________________
Function FieldGet(ByVal sData As String, ByVal sSplit As String, ByVal FieldTarget As Long) As String
Dim ChrPos As Long = 1
Dim SplitPos As Long
Dim FieldIndex As Long
If Len(sData) * Len(sSplit) Then 'Both string lenght must be non zero
Do 'Loop for every field
SplitPos = InStr(ChrPos, sData, sSplit) 'Get split position, use InStr/ANY if needed
FieldIndex += 1 'Increment field count
If FieldIndex = FieldTarget Then 'Wanted field index
If SplitPos = 0 THEN SplitPos = Len(sData) + 1 'Unique or last field
Function = Mid(sData, ChrPos, SplitPos - ChrPos) 'Return data
Exit Do 'Job done
End If
ChrPos = SplitPos + Len(sSplit) 'Prepare for possible next search
Loop While SplitPos 'Done if no more found
End If
End Function
'_____________________________________________________________________________
'
Thanks Pierre, I've returned to this project and tried your software. It seems to work fine. I've modified it a little, to get the minimum information I need wrt mouse id, buttons and movement. Spending some time trying to find out about this, on the web, it appears that there is not a specific api for usb, but that c#, etc. uses a windows sdk. I'm not at all certain if that can be used within free basic, but it seems to be that which most of the web help is based on.
Anyway, back to what you have so generously provided, I'm not certain that the cursor is what I need - I would need one per mouse, and I'm not sure if that is possible. Also, afaik, the cursor xpos/ypos is based on the screen resolution. I've tried using the lLastx/lLasty values, (which you've rem'd out) but they seem to be always zero for the usb mouse devices I have. Anyone any further ideas?
Hey,
I'm not certain that the cursor is what I need - I would need one per mouse, and I'm not sure if that is possible.
Yes this is possible, see reply #9 for the freeware EitherMouse link.
This said, I never looked on the "how to do it".
... it appears that there is not a specific api for usb
Note that RawInput* functions work with keyboard, mouse, and HID
Also, afaik, the cursor xpos/ypos is based on the screen resolution.
Have a look at ScreenToClient(), ClientToScreen(), MapWindowPoints()
Could a joystick be used?
Depending on your specific needs, it might be much easier to implement, see joyGetPos(ex), joyGetPos(Ex), JOYINFO.
Plus, some third party or manufacturer often provide DLL to make life easy.
Hi Ray, I've been keeping an eye on this thread and I don't recall why a touch screen (an overlay on an existing screen) can't be used.
Thanks for the replies. The idea is to be able to add a cheap, easily built reasonably accurate measuring device. Two applications immediately come to mind. Some mice have a resolution of 6000dpi (maybe not raw, but interpolated) and could possibly be used instead of the far more expensive linear scales for various simple diy machines, possibly converting open loop stepper systems to closed loop. The second application is to use as an encoder, either spindle driven, or by means of a hand-wheel - simply use a rotating disk below the sensor. I would like to be able to incorporate this concept within other programs that I may write in free basic to drive various m/c tools. 6000 dpi is a resolution of 0.0042mm which is more or less the accuracy of a half decent industrial mill, and is a far higher resolution than the usual hobbyist machine can achieve. If it works, it will be interesting calibrating the system, and discovering how temperature variations effect the results (and if buffering will cause jitter...)
I had looked at either mouse, it worked OK, as far as it went, but I was 'put off' by it's scripting language, and not knowing how to incorporate it in other programs.
Best wishes,
Ray
I wonder if the problems I'm getting wrt usb, could be possibly due to the cable. Maybe I need one of these https://www.mackenziehifi.com/purist-audio-design-ultimate-usb-cable-1244-p.asp
There must be an emoji for that...
Has anyone any experience of this? https://docs.microsoft.com/en-us/windows-hardware/drivers/hid/virtual-hid-framework--vhf- ? Seeing as I'm using w10, and it seems there was never a usb api for earlier windows version, it looks like it is now possible to roll your own. It will take me a while to pick my way through this, since I really haven't a clue as to what is involved, only just skimmed through the page/links, so any suggestions/guidance greatly appreciated.
Best wishes,
Ray
Hi Ray, These are the GitHub pages for 3 of the developers of https://docs.microsoft.com/en-us/windows-hardware/drivers/hid/virtual-hid-framework--vhf- (https://docs.microsoft.com/en-us/windows-hardware/drivers/hid/virtual-hid-framework--vhf-)
https://github.com/EliotSeattle (https://github.com/EliotSeattle)
https://github.com/mikemaksymowych (https://github.com/mikemaksymowych)
https://github.com/AndrewHarryKim (https://github.com/AndrewHarryKim)
They might be able to shed some light on things...
Ray,
I've been watching this thread since you started it. Your October 30 post was the first time I was able to get an idea of what you are trying to do. I have some questions if you don't mind. What mouse technology are you looking at? Optical, laser? In either case, I think you will have to do some testing to see if this idea is workable. I have some doubts. While the resolution is very high, as you mentioned, the repeatability might not be there. We don't really need repeatability in mice, at least not to the degree you need with CNC mills.
Consider this: You have a linear rail, and rigidly mounted a mouse to it such that it could only travel in a straight line, with a solid stop on each end. You slide it to one side, zero your travel count, slide it to the other side counting up your mouse output as you go. Then back to the starting position, counting down. Do that a few times to see if the start-location value floats around. How close you come to zero when you get back will tell you if your idea has merit. It should remain zero every time (or at least not float around) for CNC.
David
Hi David,
Thanks for your questions. I'm also not sure about the repeatability as a linear scale, but I will not know until I've tried it. I suspect (if the internal optical mouse algorithm is similar to the earlier serial mouse type) that there is a buffer inbuilt, which may be rapidly filled, before values can be read out. I think the actual mechanics may be quite good once calibrated (allowing for errors caused by temperature, humidity, whatever). I've a suspicion that the optical principal is similar to the capacitance detection in the cheap digital calipers. The actual accuracy of the pcb in the calipers can be quite variable, but the scanning head is quite accurate. Anyway for my original use, as a cheap rotary encoder, I don't think the accuracy/repeatability is of a major concern. The only calibration is that the faster the handwheel turns, the faster the axis must jog, and if precision location is required, you go slow as you get near to where you want to be. I can apply multiplying/dividing factors as required to get a finer or coarser resolution. For real consistency/accuracy, I'd have to disable much of what w10 wants to do, since it is far from a rtos, when I'm actually trying to do any measuring.
If the resolution/accuracy is not good enough for metal, then it'll most likely be good enough for wood machining ;-)
I have done some very rough tests, a year or two back, running a mouse along a plank with a couple of stops, and observing on screen where it was stopping. It seemed good enough for me to consider what I'm trying to do now. (Obviously plenty of room for errors in such a crude test)
Best wishes,
Ray
Hi Clive,
Thanks for your post. I think I'd better make a start on the virtual driver framework, see if I understand any of it, before I try to contact the developers. I'm not sure how you found them, I never noticed any names on the url I had. I see I'll have to translate the c++ code to free basic, too. I hope it's not involving .net... Still, if it was easy, everybody would be doing it.
Best wishes,
Ray