VB6 - key inputs and outputs

:0

Are you looking to control the mouse?  It sounds like you want to create some sort of demo program that will simulate the user's mouse movements.

Personally, I'd take the simpler approach of turning this into an animation effect, which uses an image of the mouse, moves it to various places, then processes according to a predefined script of commands (which are translated into subroutine calls.)

If on the other hand, you're trying to control another application, you'll need to use some API calls and hooks to sendmessages to the other app.

Heres what i want, ya know a macro program? well i play a game called age of empires and i use a macro program to control the mouse and like b and stuff are the hotkeys and the macro program works world wide so when i press the hotkeys on the keyboard the macro starts, but the macro was to slow for me, so im going to program something to make it go alot faster... and i cant really program in visual basic, im more C++ but my friends told me it would be easyer in vb so im asking yall to help me out :) thank you

Hi

'========bas module code=======
'========hot key staff=========
Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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

Const GWL_WNDPROC = (-4)
Const WM_HOTKEY = &H312

Public Enum ModKeys
  MOD_NONE = &H0
  MOD_ALT = &H1
  MOD_CONTROL = &H2
  MOD_SHIFT = &H4
  MOD_WIN = &H8
End Enum
'===========Mouse staff===========

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Dim iAtom As Integer
Dim OldProc As Long, hOwner As Long

Public Function SetHotKey(hWin As Long, ModKey As ModKeys, vKey As Long) As Boolean
  If hOwner > 0 Then Exit Function
  hOwner = hWin
  iAtom = GlobalAddAtom("MyHotKey")
  SetHotKey = RegisterHotKey(hOwner, iAtom, ModKey, vKey)
  OldProc = SetWindowLong(hOwner, GWL_WNDPROC, AddressOf WndProc)
End Function

Public Sub RemoveHotKey()
  If hOwner = 0 Then Exit Sub
  Call UnregisterHotKey(hOwner, iAtom)
  Call SetWindowLong(hOwner, GWL_WNDPROC, OldProc)
End Sub

Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If wMsg = WM_HOTKEY And wParam = iAtom Then
     Call MainLoop    
  Else
     WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
  End If
End Function

Private Sub MoveMouse(ByVal x As Long, ByVal y As Long, Optional bClick As Boolean = False)
    Dim lFlags As Long, curX As Long, curY As Long
    curX = x * 65535 / (Screen.Width\Screen.TwipsPerPixelsX)
    curY = y * 65535 / (Screen.Height\Screen.TwipsPerPixelsY)
    bFlags = MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE
    If bClick Then
       bFlags = bFlags + MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP
    End If
    mouse_event lFlags , curX, curY, 0, 0
End Sub

Private Sub PressCtrlB()
    SendKeys "^B"
End Sub

Public Sub MainLoop()
    For i = 1 To 105
        MoveMouse 223, 674
        PressCtrlB
        MoveMouse 223, 674, True
    Next i
End Sub

At form_load event:
   SetHotKey hwnd,MOD_NONE, vbKeyP

Cheers

<listening..>

Uhh i pasted that into my Visual basic, i had to like put the right stuff on the lines, becuz when i pasted in "entered" a few lines,but thats all ok, but when i compiled, it didn't work, it didn't give me any errors or anything, just when i pressed F9, it did nothing, are you sure that its global? like that the program can be running in the backround and when im in the game itll move the mouse inside the game also and press b while in the game and the game happens to have a hotkey that when you press b it does something, sorry im probably confusing you, but it didn't move the mouse or anything.... sorry to bother you

        Joho

Wait, in that code do i need to make like a button and name it something, probably not right? just asking...

Sorry, at form_Load event should be
SetHotKey hwnd,MOD_NONE, vbKeyF9

and in Form_Unload event:

  RemoveHotKey

Cheers

uhh sorry to tell ya dude but it's still not workin

did you try it on your computer to see if it did anything??

did you try it on your computer to see if it did anything??

I get this error:

Invalid use of AddressOf operator

at this line:

OldProc = SetWindowLong(hOwner, GWL_WNDPROC, AddressOf WndProc)

Heres my email address to make things faster

Cheeselives@home.com

Hi
Removed some typos/bugs:

'=====Bas module==
Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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

Const GWL_WNDPROC = (-4)
Const WM_HOTKEY = &H312

Public Enum ModKeys
 MOD_NONE = &H0
 MOD_ALT = &H1
 MOD_CONTROL = &H2
 MOD_SHIFT = &H4
 MOD_WIN = &H8
End Enum
'===========Mouse staff===========

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000

Dim iAtom As Integer
Dim OldProc As Long, hOwner As Long
Public bEnable As Boolean

Public Function SetHotKey(hWin As Long, ModKey As ModKeys, vKey As Long) As Boolean
 If hOwner > 0 Then Exit Function
 hOwner = hWin
 iAtom = GlobalAddAtom("MyHotKey")
 SetHotKey = RegisterHotKey(hOwner, iAtom, ModKey, vKey)
 OldProc = SetWindowLong(hOwner, GWL_WNDPROC, AddressOf WndProc)
End Function

Public Sub RemoveHotKey()
 If hOwner = 0 Then Exit Sub
 Call UnregisterHotKey(hOwner, iAtom)
 Call SetWindowLong(hOwner, GWL_WNDPROC, OldProc)
End Sub

Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 If wMsg = WM_HOTKEY And wParam = iAtom And bEnable Then
    Call MainLoop
 Else
    WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
 End If
End Function

Private Sub MoveMouse(ByVal x As Long, ByVal y As Long, Optional bClick As Boolean = False)
   Dim lFlags As Long, curX As Long, curY As Long
   curX = x * 65535 * Screen.TwipsPerPixelX / Screen.Width
   curY = y * 65535 * Screen.TwipsPerPixelY / Screen.Height
   lFlags = MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE
   Debug.Print curX, curY
   If bClick Then
      lFlags = lFlags + MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP
   End If
   mouse_event lFlags, curX, curY, 0, 0
End Sub

Private Sub PressCtrlB()
   SendKeys "^B", True
End Sub

Public Sub MainLoop()
   Dim i As Integer
   For i = 1 To 105
       MoveMouse 223, 674 'move mouse at pos without click
       PressCtrlB 'Press Ctrl + B
       MoveMouse 0, 0 'move mouse at top left corner
       MoveMouse 223, 674, True 'move at pos + Click
   Next i
End Sub

'====Form code===
'Add command button
Private Sub Command1_Click()
  bEnable = True
End Sub

Private Sub Form_Load()
  SetHotKey hwnd, MOD_NONE, vbKeyF9
End Sub

Private Sub Form_Unload(Cancel As Integer)
  RemoveHotKey
End Sub

'Start app, click command button. Then activate any other app. Press F9 - mouse will move and key pressed.

Cheers

listening...

I still get the "Invalid use of AddressOf operator" error.

see it wont do anything because on this line,

OldProc = SetWindowLong(hOwner, GWL_WNDPROC, AddressOf WndProc)

because that line doesn't work, it doesn't store the hotkey or something like that, and it doesn't do all of the crap because it doesn't know that your pressing F9, so it doesn't do all of that crap, its that damn wndproc and addressof wndproc that is holding it back...

     Joho

Oh....
See sample at your mail box.

Cheers

hey dude that rocks, buuuut its not world wide, see the program can, not be active, (has the grey titlebar) and still work, but it didn't work when i went into Age of empires, it would't work inside that program... sorry to have to ask but is there anyway you could get it to work while Age of empires is active? thats all i need to accept your answer and give you an A+++ man youve been so helpful!

Here is an much abridged version.

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000

Sub Main()
    Form1.Show
    StartMonitoringF9
End Sub

Public Sub StartMonitoringF9()

    Do While DoEvents()
        If GetAsyncKeyState(vbKeyF9) < 0 Then
            ProcessF9
            Exit Sub
        End If
    Loop

End Sub

Private Sub ProcessF9()

    Dim i As Integer
   
    For i = 1 To 105
        MoveMouse 223, 674
        SendKeys "^B"
        MoveMouse 223, 674, True
    Next i

End Sub

Private Sub MoveMouse(ByVal x As Long, ByVal y As Long, Optional bClick As Boolean = False)
  Dim lFlags As Long, curX As Long, curY As Long
  curX = x * 65535 * Screen.TwipsPerPixelX / Screen.Width
  curY = y * 65535 * Screen.TwipsPerPixelY / Screen.Height
  lFlags = MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE
  If bClick Then
     lFlags = lFlags + MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP
  End If
  mouse_event lFlags, curX, curY, 0, 0
End Sub

This should work from anywhere.

Vin.

Hey man, thanks... It seems to work... Once

Then no more... Also it looks like that when its going through the 105 loop, it only goes through it once... i don't know why.

I'm not sure but you may need to put in a slight delay between the mouse clicks the may be being interpreted as a double click rather than a single click. You can check if all 105 are being processed by using the Debugger.

Debug.Print Str(i)

To add a slight delay add the following

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

Private Sub ProcessF9()

    Dim i As Integer
   
    For i = 1 To 105
        MoveMouse 223, 674
        SendKeys "^B"
        MoveMouse 223, 674, True
        Sleep(100)
    Next i
    StartMonitoringF9

End Sub

Vin.

Alright dude thanks it all works now, great...