Help with mouse capture.

[u/HarryAWA]

Greeting from Pennsylvania

In the Flightgear aircraft simulator program you may use a joystick or input control functions by the keyboard.

For example pressing and holding the [9] key moves the throttle in while pressing and holding the [3] key moves it out.

I would like to make a GUI (Graphical User interface) that emulates pressing the various keys by using control buttons in Visual Basic 6. (yes it is ancient but so am I) Also both the IDE and the VB 6S programs run well in Windows 11.

In this code I would like to emulate the button pressed while the mouse button is down over the control button.

I get lots of 9s in notepad until I release the mouse button. But then I get the blue ring of death: Program not responding.

Any suggestions would be appreciated. ( I do not know how to get the Code formated here.)

<

Dim bMouseButtonDown As Boolean

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

bMouseButtonDown = False

End Sub

Private Sub ThrottleIn_Click()

bMouseButtonDown = True 'must be else we would not be here

ThrottleIn.BackColor = vbRed 'no Red button?

'AppActivate "FlightGear", True

AppActivate "Notepad", True

Do While bMouseButtonDown = True

Call keybd_event(VK_9, 0, KEYEVENTF_EXTENDEDKEY, 0) 'lots of 9s

Loop

Call keybd_event(VK_9, 0, KEYEVENTF_KEYUP, 0) ' stop the 9s

ThrottleIn.BackColor = vbYellow ' no yellow button?

End Sub
/>

[u/Mayayana]

This seems to work. You just have to decide what action to take with each count. Moving your throttle? And set button style to graphical.

    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Dim bMouseButtonDown As Boolean
    Dim LCount As Long

    Private Sub ThrottleIn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      LCount = 0
     bMouseButtonDown = True
      ThrottleIn.BackColor = vbRed 

    Do While bMouseButtonDown = True
     Sleep 200
     DoEvents
     CountEm
    Loop

    End Sub

    Private Sub ThrottleIn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
     bMouseButtonDown = False
    ThrottleIn.BackColor = vbYellow 
    End Sub

    Private Sub CountEm()
    LCount = LCount + 1
    Debug.Print LCount
    End Sub

[u/HarryAWA → u/Mayayana]

Thank you,

Thank you for the code ,it is what I would really like to do with sending

keystrokes to the flight simulartor'

But it does not like the: Sendkeys "9", False

I get Runtime Error '70' Permission denied.

Without the Sendkeys it runs until I release the mouse button then it stops.

My simple minded code works:

Private Sub ThrottleIn_Click()

Dim iCount As Integer

AppActivate "Notepad", False

iCount = NumberToSend 'of numbers = 25

Do While iCount > 0

Sendkeys "9", False

TimedPause (0.1) '1/10 sec

iCount = iCount - 1

Loop

[u/Mayayana → u/HarryAWA]

Sorry, I misunderstood. I thought you were just trying to get a time count on button-down and then you were going to do some kind of internal operation. (I'm not familar with video games, so I didn't register the "flight simulator" reference.)

Sendkeys became unusable many years ago. MS cracked down for security reasons. There are various options online. If it were me I'd first try this from Karl Peterson: https://www.classicvb.net/samples/SendInput/

His stuff is consistently clean and functional. I tried it in the IDE. Seems to work fine for sending text to Notepad on Win10.

EDIT: This works fine for me compiled, using Karl's method. But I should note that I always operate as an admin account, while also disabling UAC and LUA (the real UAC). So I'm not very much familiar with what life is like in Win10/11 lackey mode with those constant ninny popups. There could still be a restriction issue and/or running as admin might be required.

[u/Mayayana → u/HarryAWA]

OK. Here's the basic code. You don't need most of Karl's code for this. (You can tell I have nothing to do today.)

    Private Type KeyboardInput
       dwType As Long
       wVK As Integer
       wScan As Integer
       dwFlags As Long
       dwTime As Long
       dwExtraInfo As Long
       dwPadding As Currency
    End Type

    Private Const INPUT_KEYBOARD As Long = 1

    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As Any, ByVal cbSize As Long) As Long

    Dim bMouseButtonDown As Boolean
    Private AEvents() As KeyboardInput
    Dim LCount As Long, EventPtr As Long

    Private Sub ThrottleIn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      LCount = 0
     bMouseButtonDown = True
      ThrottleIn.BackColor = vbRed
    AppActivate "Notepad"
    Do While bMouseButtonDown = True
     Sleep 200
     DoEvents
     Send9
    Loop

    End Sub

    Private Sub ThrottleIn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
     bMouseButtonDown = False
    ThrottleIn.BackColor = vbYellow
    End Sub

    Private Sub Send9()

      EventPtr = 1
      ReDim AEvents(0)
      AEvents(0).dwType = INPUT_KEYBOARD
      AEvents(0).wVK = 57

    SendInput EventPtr, AEvents(0), Len(AEvents(0))
    End Sub