Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need API to Manage Another Programs Windows ! 1

Status
Not open for further replies.

jdbee

Programmer
Jan 14, 2001
2
Writing an app that uses Sendkeys to Transfer data to a third party program. Basically it mimics a Users Data Entry. Used to work before, but after subsequent Win98 updates from Microsoft, doesn't work anymore. Microsoft kb supplies Findwindow API and BringWindowToTop to make an application active but the code does not seem to work. The window and it's Child Windows is visible behind mine and becomes active when the mouse clicks on it. I can't seem to send keystrokes to it. My app must also remain topmost to the right of this app. Can anyone help. Getting desparate to get the program running again.
 
normally appactivate should do the trick, but you need to know the window title.
there are also api's for moving the mouse and clicking:
Code:
' *************************************************************************
'  Copyright ©2000 Karl E. Peterson, All Rights Reserved
'  Find this and more samples at <[URL unfurl="true"]http://www.mvps.org/vb>[/URL]
' *************************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code, non-compiled, without prior written consent.
' *************************************************************************
Option Explicit

Private Declare Function GetWindowRect Lib &quot;user32&quot; (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib &quot;user32&quot; (ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib &quot;user32&quot; (ByVal dwFlags As Long, ByVal dX As Long, ByVal dY As Long, ByVal dwData As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib &quot;kernel32&quot; (ByVal dwMilliseconds As Long)

' API structure definition for Rectangle
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

' Flags used with mouse_event
Private Const MOUSEEVENTF_ABSOLUTE = &amp;H8000&amp; ' absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &amp;H2     ' left button down
Private Const MOUSEEVENTF_LEFTUP = &amp;H4       ' left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &amp;H20  ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &amp;H40    ' middle button up
Private Const MOUSEEVENTF_MOVE = &amp;H1         ' mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &amp;H8    ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &amp;H10     ' right button up
Private Const MOUSEEVENTF_WHEEL = &amp;H800      ' wheel button rolled

' GetSystemMetrics() codes
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

' Value used to scale wheel movement
Private Const WHEEL_DELTA As Long = 120

' A few module level variables...
Private m_ScreenWidth As Long
Private m_ScreenHeight As Long
Private m_ClickDelay As Long

' Virtual scaling applied to screen...
Private Const m_Scale As Long = &amp;HFFFF&amp;

' Direction for wheel to turn...
Public Enum WheelDirections
   meWheelForward = WHEEL_DELTA
   meWheelBackward = -WHEEL_DELTA
End Enum

' ***********************************************************
'  Initialize
' ***********************************************************
Private Sub Class_Initialize()
   ' Store screen dimensions in pixels
   m_ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
   m_ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
   ' Default duration for mousedown
   m_ClickDelay = 250 'milliseconds
End Sub

' ***********************************************************
'  Public Properties
' ***********************************************************
Public Property Let ClickDelay(ByVal NewVal As Long)
   If NewVal >= 0 Then m_ClickDelay = NewVal
End Property

Public Property Get ClickDelay() As Long
   ClickDelay = m_ClickDelay
End Property

' ***********************************************************
'  Public Methods
' ***********************************************************
Public Sub ButtonPress(ByVal Button As MouseButtonConstants)
   ' Depress mouse button at current screen location.
   Select Case Button
      Case vbLeftButton, vbMiddleButton, vbRightButton
         Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
      Case vbMiddleButton
         Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
      Case vbRightButton
         Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
   End Select
End Sub

Public Sub ButtonRelease(ByVal Button As MouseButtonConstants)
   ' Release mouse button at current screen location.
   Select Case Button
      Case vbLeftButton, vbMiddleButton, vbRightButton
         Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
      Case vbMiddleButton
         Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
      Case vbRightButton
         Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
   End Select
End Sub

Public Sub Click()
   ' Click the mouse, with delay to simulate human timing.
   Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
   If m_ClickDelay Then
      DoEvents ' allow down position to paint
      Call Sleep(m_ClickDelay)
   End If
   Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub

' X/Y need to be passed as pixels!
Public Sub ClickAbsolute(ByVal X As Long, ByVal Y As Long)
   ' Move cursor to destination, first.
   Call Me.MoveTo(X, Y)
   ' Click it
   Call Me.Click
End Sub

Public Sub ClickWindow(ByVal hWnd As Long)
   ' Move cursor to window
   Call Me.MoveToWindow(hWnd)
   ' Click it
   Call Me.Click
End Sub

' X/Y need to be passed as pixels!
Public Sub MoveTo(ByVal X As Long, ByVal Y As Long, Optional ByVal Absolute As Boolean = True)
   Dim meFlags As Long
   
   If Absolute Then
      ' Map into same coordinate space used by mouse_event.
      X = (X / m_ScreenWidth) * m_Scale
      Y = (Y / m_ScreenHeight) * m_Scale
      ' Set flags
      meFlags = MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE
   Else
      ' Set flags for relative movement
      meFlags = MOUSEEVENTF_MOVE
   End If
   
   ' Move the cursor to destination.
   Call mouse_event(meFlags, X, Y, 0, 0)
End Sub

Public Sub MoveToWindow(ByVal hWnd As Long)
   Dim X As Long, Y As Long
   Dim r As RECT
   
   ' Place origin in center of control.
   If GetWindowRect(hWnd, r) <> 0 Then
        X = r.Left + (r.Right - r.Left) \ 2
        Y = r.Top + (r.Bottom - r.Top) \ 2
        Call Me.MoveTo(X, Y)
   Else
   MsgBox ApiCalls.ApiErrorText(Err.LastDllError)
   End If
End Sub

' Not supported in Windows95!
Public Sub TurnWheel(Optional ByVal Notches As Long = 1, Optional ByVal Direction As WheelDirections = meWheelBackward)
   Dim dwData As Long
   
   ' Validate direction
   If Direction <> meWheelBackward And Direction <> meWheelForward Then
      Direction = meWheelBackward
   End If
   
   ' Turn the wheel
   dwData = Notches * Direction
   Call mouse_event(MOUSEEVENTF_WHEEL, 0, 0, dwData, 0)
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top