Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples5/ch06/simkeys.frm

Visual Basic Form | 1997-02-16 | 7.9 KB | 265 lines

VERSION 5.00
Begin VB.Form frmSimKeys
   Caption         =   "Send Keys and Mouse Events"
   ClientHeight    =   4725
   ClientLeft      =   1095
   ClientTop       =   1515
   ClientWidth     =   6870
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4725
   ScaleWidth      =   6870
   Begin VB.CommandButton cmdClickMe
      Caption         =   "Click Me"
      Height          =   435
      Left            =   5520
      TabIndex        =   9
      Top             =   4140
      Width           =   1275
   End
   Begin VB.Timer Timer1
      Left            =   5880
      Top             =   3480
   End
   Begin VB.TextBox txtDelay
      Height          =   315
      Left            =   5520
      TabIndex        =   7
      Text            =   "2"
      Top             =   2880
      Width           =   1215
   End
   Begin VB.TextBox txtTarget
      Height          =   315
      Left            =   120
      TabIndex        =   6
      Top             =   420
      Width           =   5235
   End
   Begin VB.CommandButton cmdCaptureActive
      Caption         =   "Capture Active"
      Height          =   435
      Left            =   5460
      TabIndex        =   5
      Top             =   1860
      Width           =   1335
   End
   Begin VB.CommandButton cmdCaptureAll
      Caption         =   "Capture Screen"
      Height          =   435
      Left            =   5460
      TabIndex        =   4
      Top             =   1380
      Width           =   1335
   End
   Begin VB.CommandButton cmdMouseMove
      Caption         =   "MyMouseMove"
      Height          =   435
      Left            =   5460
      TabIndex        =   3
      Top             =   900
      Width           =   1335
   End
   Begin VB.CommandButton cmdSendKeys
      Caption         =   "MySendKeys"
      Height          =   435
      Left            =   5460
      TabIndex        =   2
      Top             =   420
      Width           =   1335
   End
   Begin VB.TextBox txtSource
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Text            =   "Text to be entered by sendkeys"
      Top             =   60
      Width           =   6675
   End
   Begin VB.PictureBox Picture1
      Height          =   3735
      Left            =   120
      ScaleHeight     =   3705
      ScaleWidth      =   5205
      TabIndex        =   0
      Top             =   840
      Width           =   5235
   End
   Begin VB.Label Label1
      Caption         =   "Delay (seconds)"
      Height          =   255
      Left            =   5520
      TabIndex        =   8
      Top             =   2580
      Width           =   1155
   End
Attribute VB_Name = "frmSimKeys"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Copyright
 1997 by Desaware Inc. All Rights Reserved
' 0 if no operation is in progress
' 1 if sending keys
' 2 if sending mouse commands
' 3 if capturing the whole screen
' 4 if capturing the active window
Dim OperationInProgress%
Dim IsWindows95%
Private Sub cmdCaptureActive_Click()
    Dim delay&
    If OperationInProgress Then
        MsgBox "Wait for prior operation to finish"
        Exit Sub
    End If
    delay& = Val(txtDelay)
    If delay& = 0 Then
        MyCapture 1
    Else
        OperationInProgress = 4
        Timer1.Interval = delay& * 1000
        Timer1.Enabled = True
    End If
End Sub
Private Sub cmdCaptureAll_Click()
    Dim delay&
    If OperationInProgress Then
        MsgBox "Wait for prior operation to finish"
        Exit Sub
    End If
    delay& = Val(txtDelay)
    If delay& = 0 Then
        MyCapture 0
    Else
        OperationInProgress = 3
        Timer1.Interval = delay& * 1000
        Timer1.Enabled = True
    End If
End Sub
Private Sub cmdClickMe_Click()
    MsgBox "Button has been clicked"
End Sub
Private Sub cmdMouseMove_Click()
    Dim delay&
    If OperationInProgress Then
        MsgBox "Wait for prior operation to finish"
        Exit Sub
    End If
    delay& = Val(txtDelay)
    If delay& = 0 Then
        MyMouseMove
    Else
        OperationInProgress = 2
        Timer1.Interval = delay& * 1000
        Timer1.Enabled = True
    End If
End Sub
Private Sub cmdSendKeys_Click()
    Dim delay&
    If OperationInProgress Then
        MsgBox "Wait for prior operation to finish"
        Exit Sub
    End If
    delay& = Val(txtDelay)
    If delay& = 0 Then
        MySendKeys txtSource.Text
    Else
        OperationInProgress = 1
        Timer1.Interval = delay& * 1000
        Timer1.Enabled = True
    End If
End Sub
Private Sub Form_Load()
    Dim dl&
    Dim osinfo As OSVERSIONINFO
    osinfo.dwOSVersionInfoSize = Len(osinfo)
    dl& = GetVersionEx(osinfo)
    If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then IsWindows95 = True
End Sub
Private Sub timer1_Timer()
    Timer1.Enabled = False
    Select Case OperationInProgress
        Case 1
                MySendKeys txtSource.Text
        Case 2
                MyMouseMove
        Case 3
                MyCapture 0
        Case 4
                MyCapture 1
    End Select
    OperationInProgress = 0
End Sub
' Setting mode to 1 causes capture of the active window only
Public Sub MyCapture(ByVal mode%)
    Dim altscan%
    Dim dl&
    Dim snapparam%
    altscan% = MapVirtualKey(VK_MENU, 0)
    cmdCaptureAll.Enabled = False
    cmdCaptureActive.Enabled = False
    Screen.MousePointer = vbHourglass
    If mode Then
        keybd_event VK_MENU, altscan, 0, 0
        ' It seems necessary to let this key get processed before
        ' taking the snapshot.
    End If
    ' Why does this work?  Who knows!
    If mode = 0 And IsWindows95 Then snapparam = 1
    DoEvents    ' These seem necessary to make it reliable
    ' Take the snapshot
    keybd_event VK_SNAPSHOT, snapparam, 0, 0
    DoEvents
    Picture1.Picture = Clipboard.GetData(vbCFBitmap)
    If mode Then keybd_event VK_MENU, altscan, KEYEVENTF_KEYUP, 0
    cmdCaptureAll.Enabled = True
    cmdCaptureActive.Enabled = True
    Screen.MousePointer = vbDefault
End Sub
' Try to move the mouse to click the "click me" button
Public Sub MyMouseMove()
    Dim pt As POINTAPI
    Dim dl&
    Dim destx&, desty&, curx&, cury&
    Dim distx&, disty&
    Dim screenx&, screeny&
    Dim finished%
    Dim ptsperx&, ptspery&
    ' Get screen coordinates first
    ' 10 by 10 pixels into the button
    pt.x = 10
    pt.y = 10
    dl& = ClientToScreen(cmdClickMe.hwnd, pt)
    screenx& = GetSystemMetrics(SM_CXSCREEN)
    screeny& = GetSystemMetrics(SM_CYSCREEN)
    destx& = pt.x * &HFFFF& / screenx&
    desty& = pt.y * &HFFFF& / screeny&
    ' About how many mouse points per pixel
    ptsperx& = &HFFFF& / screenx&
    ptspery& = &HFFFF& / screeny&
    ' Now move it
    Do
        dl& = GetCursorPos(pt)
        curx& = pt.x * &HFFFF& / screenx&
        cury& = pt.y * &HFFFF& / screeny&
        distx& = destx& - curx&
        disty& = desty& - cury&
        If (Abs(distx&) < 2 * ptsperx& And Abs(disty&) < 2 * ptspery) Then
            ' Close enough, go the rest of the way
            curx& = destx&
            cury& = desty&
            finished% = True
        Else
            ' Move closer
            curx& = curx& + Sgn(distx&) * ptsperx * 2
            cury& = cury& + Sgn(disty&) * ptspery * 2
        End If
        mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, curx, cury, 0, 0
    Loop While Not finished
    ' We got there, click the button
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, curx, cury, 0, 0
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTUP, curx, cury, 0, 0
End Sub