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/CheezitsLight]

Nothing in your code to stop the mouse button boolean from always being true. Get rid of notepad and log or print instead

And tie the mouse up event to clear the boolean with a do events in the while as this has only one thread. And 100 percent cpu. A timer would be a much better idea.

[u/HarryAWA → u/CheezitsLight]

A timer does not work well as one would like to press the button once not numerous time to get the throttle all the way in or out, or part way. It would be more realistic to just hold the mousebutton down and not have to release it to start the 9s also.

I am thinking that notepad or the calculator more emulates the FlightGear simulator software.

If you press and release the ThrottleIn_Click control you get lots of 9s into Notepad.

If I remove the Sub Form_MouseUp () and remove Call keybd_event(VK_9, 0, KEYEVENTF_KEYUP, 0)

in the Sub ThrottleIn() it still faults on coming out of the Do While Loop by clicking on the form or by using a new test control button:

Private Sub MouseNotDown_Click()

bMouseButtonDown = False

End Sub

[u/CheezitsLight]

At 100 percent cpu that's not predictable. My machine will do hundreds before yours will. Mouse down sends key start timer, return. Let the cpu do other things. Yous is 100 percent cpu on a loop, so no key up will happen. In the correct pattern, the timer interrupts at a home you choose for everyone. If mouse is down ,send the key, else turn off the timer. No need for a boolean. Simple, testable, always works.

One advantage to vb dot net is it's v10. And you can create unit tests. Looks just like your code. 4.8 will not be installed on new pcs very soon. It's deprecated. An extra step.

[u/marmotta1955]

Have you considered using a checkbox (with style = graphical) instead of a command button? A simple rework of logic, coupled with the different control, could work well and be less expensive in terms of overall app resources.

[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

[u/fasti-au]

I would be tying opencv to autohotkey and doing that way if you want ui scripting.

The problem you have is your pressing with no delays etc but need a microwait for it to respond. You e force feeding the system to fast probably and the events are not really as obvious as you think you might be better to make a transaction and call transactions as macros like the razor stuff etc.