PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: [1] 2

Author Topic: mice - usb devices  (Read 836 times)


  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
mice - usb devices
« on: September 12, 2018, 06:06:29 PM »

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.

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #1 on: September 12, 2018, 11:37:34 PM »

Yes you can,
Look at GetRawInputData() and GetRawInputDeviceInfo()...

Code: [Select]
'Extract from Josť's stuff...
GetRawInputData function uiCommand = RID_HEADER

   mouse     AS RAWMOUSE      ' RAWMOUSE
   hid       AS RAWHID        ' RAWHID



GetRawInputDeviceInfo function
 hDevice A handle to the raw input device.

Josť Roca

  • FireFly3 Registered User
  • Master Member
  • *
  • Posts: 3103
    • Jos
Re: mice - usb devices
« Reply #2 on: September 13, 2018, 12:02:54 AM »

The declares and types for FreeBasic are available in, eg.

Code: [Select]
union tagRAWINPUT_data
mouse as RAWMOUSE
keyboard as RAWKEYBOARD
hid as RAWHID
end union

type tagRAWINPUT
data as tagRAWINPUT_data
end type


Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #3 on: September 13, 2018, 12:25:13 AM »

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...
« Last Edit: September 13, 2018, 01:37:11 AM by Pierre Bellisle »


  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
Re: mice - usb devices
« Reply #4 on: September 13, 2018, 12:59:28 PM »

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 (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, 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, has been criticized in later posts. Are there any complete and better explained examples?

Best wishes,


** probably much more than that.

Josť Roca

  • FireFly3 Registered User
  • Master Member
  • *
  • Posts: 3103
    • Jos
Re: mice - usb devices
« Reply #5 on: September 13, 2018, 01:09:28 PM » in no my stuff. It is an include file that comes with the Free Basic compiler.

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #6 on: September 13, 2018, 01:47:04 PM »

Hi Ray,
Sadly on my side I don't think I will code around this subject in a near future...


  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
Re: mice - usb devices
« Reply #7 on: September 13, 2018, 07:50:45 PM »

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.


  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
Re: mice - usb devices
« Reply #8 on: September 16, 2018, 12:08:15 PM »

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.

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #9 on: September 21, 2018, 08:20:44 AM »

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, use the zip for a no install standalone.



  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
Re: mice - usb devices
« Reply #10 on: September 21, 2018, 03:08:36 PM »

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.

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #11 on: September 22, 2018, 12:04:51 AM »

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.


  • FireFly3 User
  • Senior Member
  • *
  • Posts: 208
Re: mice - usb devices
« Reply #12 on: September 22, 2018, 09:12:27 PM »

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.

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #13 on: September 24, 2018, 12:30:44 AM »

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:
Code: [Select]
#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 ""
#Include Once "" 'Format
#Include Once "win\"
#Include Once "win\"

#Define AppName         "Raw mouse"

#Define ButtonExit      101
#Define ButtonTextClear 102
#Define Edit            201
#Define LineSeparator   String(75, 45)

Const HTab               = !"\9"

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 @
 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)
 End If

End Function

Function WinError(ByVal ErrorCode As DWord) As String
 Dim pzError  As LPTSTR 'wString Pointer
 Dim ErrorLen As DWord

                          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
   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.
   sState &= "MOUSE_MOVE_ABSOLUTE, "      '1 Mouse movement data is based on absolute position.
   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_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
       g->HardId(0) = zPropertyBuffer
     End If
   End If
   zPropertyBuffer = sDef & HTab & HTab & zPropertyBuffer

   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
« Last Edit: October 02, 2018, 10:58:58 PM by Pierre Bellisle »

Pierre Bellisle

  • FireFly3 User
  • Junior Member
  • *
  • Posts: 83
Re: mice - usb devices
« Reply #14 on: September 24, 2018, 12:31:22 AM »

Part two:
Code: [Select]
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")
 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))
   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("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
       EXIT DO
     End If
     DevCount += 1
 End If

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)


     '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")

    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

          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


        Case RIM_TYPEHID 'Not a keyboard, nor a mouse but joystrick, etc...

      End Select

    EditAdd(" - WM_INPUT")
    '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
         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
         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)
           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

       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.

      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

        Case ButtonExit, IDCANCEL
          If Code = BN_CLICKED Or Code = 1 Then
            Function = ControlId
            PostMessage(hWnd, WM_CLOSE, 0, 0)
            Exit Function

     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

     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          = 900          = 700
 WinClass.hIcon         = ExtractIcon(hInstance, "%SystemRoot%\system32\shell32.dll", 293)         = 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, _
                         (GetSystemMetrics(SM_CXSCREEN) - / 2, _ 'PosX
                         (GetSystemMetrics(SM_CYSCREEN) - / 2, _ 'PosY
               ,, _ 'SizeX, SizeY
                         Null, Null, hInstance, Null)

   ShowWindow(hWnd, SW_SHOW)

   While GetMessage(@wMsg, ByVal Null, 0, 0) > 0
     If IsDialogMessage(hWnd, @wMsg) = 0 Then
     End If

  End If
  Function = wMsg.message

End Function

End WinMain(hInstance, Null, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
« Last Edit: September 27, 2018, 10:45:09 AM by Pierre Bellisle »
Pages: [1] 2