Hi is there any way I can change the mouse cursor in Visio programmatically?
I went through all the Automation classes in Visio SDK and could not find any related property, method, event....
-- Edit: Even while you can programmatically change the cursor, it seems that Visio (2003 in my computer) continuously restores the original cursor. I've tried it and, if I don't move the mouse, I can get a different cursor (like the hand) until I move the mouse, then it goes back to the arrow.
So, for now, my answer is: you can't change the cursor.
Maybe it is possible for other Visio versions.
You can use Windows API calls from your VBA code to change the cursor.
There is an example here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=929
A better example, which I have got to work in Visio: http://www.tek-tips.com/viewthread.cfm?qid=1700789
And below, the code I have used for the testing environment:
First, create a "modCursor" module:
Option Explicit
'Declare Windows API Constants for Windows System cursors.
Public Const IDC_APPSTARTING = 32650& 'Standard arrow and small hourglass.
Public Const IDC_ARROW = 32512& 'Standard arrow.
Public Const IDC_CROSS = 32515 'Crosshair.
Public Const IDC_HAND = 32649 'Hand.
Public Const IDC_HELP = 32651 'Arrow and question mark.
Public Const IDC_IBEAM = 32513& 'Text I-beam.
Public Const IDC_ICON = 32641& 'Windows NT only: Empty icon.
Public Const IDC_NO = 32648& 'Slashed circle.
Public Const IDC_SIZE = 32640& 'Windows NT only: Four-pointed arrow.
Public Const IDC_SIZEALL = 32646& 'Four-pointed arrow pointing north, south, east, and west.
Public Const IDC_SIZENESW = 32643& 'Double-pointed arrow pointing northeast and southwest.
Public Const IDC_SIZENS = 32645& 'Double-pointed arrow pointing north and south.
Public Const IDC_SIZENWSE = 32642& 'Double-pointed arrow pointing northwest and southeast.
Public Const IDC_SIZEWE = 32644& 'Double-pointed arrow pointing west and east.
Public Const IDC_UPARROW = 32516& 'Vertical arrow.
Public Const IDC_WAIT = 32514& 'Hourglass.
'Declarations for API Functions.
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
'Declare handles for cursor.
Private hOldCursor As Long
Private hNewCursor As Long
'The UseCursor function will load and set a system cursor or a cursor from file to a
'controls event property.
Public Function UseCursor(ByVal NewCursor As Variant)
'Load new cursor.
Select Case TypeName(NewCursor)
Case "String" 'Custom cursor from file.
hNewCursor = LoadCursorFromFile(NewCursor)
Case "Long", "Integer" 'System cursor.
hNewCursor = LoadCursor(ByVal 0&, NewCursor)
Case Else 'Do nothing
End Select
'If successful set new cursor.
If (hNewCursor > 0) Then
hOldCursor = SetCursor(hNewCursor)
End If
'Clean up.
hOldCursor = DestroyCursor(hNewCursor)
hNewCursor = DestroyCursor(hOldCursor)
End Function
Second, create a Class Module, "MouseListener":
Option Explicit
Dim WithEvents vsoWindow As Window
Private Sub Class_Initialize()
Set vsoWindow = ActiveWindow
End Sub
Private Sub Class_Terminate()
Set vsoWindow = Nothing
End Sub
Private Sub vsoWindow_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
If Button = 1 Then
Debug.Print "Left mouse button clicked"
ElseIf Button = 2 Then
Debug.Print "Right mouse button clicked"
ElseIf Button = 16 Then
Debug.Print "Center mouse button clicked"
End If
End Sub
Private Sub vsoWindow_MouseMove(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
Debug.Print "x-position is "; x
Debug.Print "y-position is "; y
modCursor.UseCursor modCursor.IDC_HAND
End Sub
Private Sub vsoWindow_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
If Button = 1 Then
Debug.Print "Left mouse button released"
modCursor.UseCursor modCursor.IDC_HAND
ElseIf Button = 2 Then
Debug.Print "Right mouse button released"
modCursor.UseCursor modCursor.IDC_ARROW
ElseIf Button = 16 Then
Debug.Print "Center mouse button released"
End If
End Sub
Third, insert the following code into the "ThisDocument" module:
Private myMouseListener As MouseListener
Private Sub Document_DocumentSaved(ByVal doc As IVDocument)
Set myMouseListener = New MouseListener
End Sub
Private Sub Document_BeforeDocumentClose(ByVal doc As IVDocument)
Set myMouseListener = Nothing
End Sub
Now, by moving the mouse and clicking the buttons you get some information in the immediate window.
If you click the left button, the cursor changes to the hand, but when you move the mouse again, the cursor changes back. The only explanation I can think of is that Visio's events are changing the cursor icon depending on the (visual) context.
Regards,
Related
The Problem
Call a procedure whenever the Main Excel Window is resized.
First attempt:
Sub Workbook_WindowResize(ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
The sub routine is called whenever the 'inner' workbook window is resized but not when the application window is resized. I.E. occcurs on resize of the Multiple Document Interface child containing the application instance.
Second attempt
Dim WithEvents App As Application
Private Sub App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
Oddly, the same thing that happened before occurs, which definitely surprised me. The event only occurs when the workbook window is resized instead of the application window.
For this reason I started looking into using the windows API.
There are many examples of setting SystemWide keyboard and mouse hooks using the windows APIs. This is along the same lines:
Public Enum enHookTypes
WH_CALLWNDPROC = 4
WH_CALLWNDPROCRET = 12
WH_CBT = 5
WH_DEBUG = 9
WH_FOREGROUNDIDLE = 11
WH_GETMESSAGE = 3
WH_HARDWARE = 8
WH_JOURNALPLAYBACK = 1
WH_JOURNALRECORD = 0
WH_MOUSE = 7
WH_MSGFILTER = (-1)
WH_SHELL = 10
WH_SYSMSGFILTER = 6
WH_KEYBOARD_LL = 13
WH_MOUSE_LL = 14
WH_KEYBOARD = 2
End Enum
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As LongPtr
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
'Ensure that your hook procedure does not interfere with the normal operation of other hook procedures
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hndl As Long
Sub HookWindow()
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
Debug.Print hndl & "~~" & GetLastError()
End Sub
Sub unhookWindow()
ret = UnhookWindowsHookEx(hndl)
Debug.Print ret
End Sub
Public Sub measureWindow(code As Long, wParam As Long, lParam As Long)
If code > 0 Then
Debug.Print ThisWorkbook.Windows(1).Width & "x" & ThisWorkbook.Windows(1).Height
Else
ret = CallNextHookEx(measureWindow, code, wParam, lParam)
End If
End Sub
Results:
If I replace the WH_CALLWNDPROC in:
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
with WH_KEYBOARD_LL the sub-routine is called whenever a key is pressed. Similarly, if I replace it with WH_MOUSE_LL the sub-routine is called whenever the mouse is moved or a mouse button pressed.
The problem is that when I try to hook the sub-routine to WH_CALLWNDPROC nothing happens?
Why?
I'm still not sure, but the same is true for all ENUMS in enHookTypes except WH_MOUSE_LL and WH_KEYBOARD_LL. Looking through the WinAPI documentation I read that you can use GetLastError from Kernel32.dll do get some indication of why the operation failed.
The error numbers I have got so far are (in decimal) error 5 (for JOURNAL hooks) and error 1428 for the rest.
Ultimately this also failed.
Application.Windows is a collection of window objects of Worbooks opened within the Application. The WindowResize event is raised when a non-maximized window changes size. The Workbook_WindowResize(ByVal Wn As Window) is exposed within the workbook object itself. The Application_WindowResize(ByVal Wb as Workbook, ByVal Wn As Window) event has to do with ANY/ALL of the workbooks within the Application when a non-maximized workbook's window changes size. Hence the difference in references passed in by the events. It is just a Window in the first case, of the workbook that raised the event, within the workbook object, and there is no question here which window it is (it's the "Me" workbook's window). It is both the Workbook and that workbook's window when it is raised at the Application level since the workbook the event relates to needs identification :) And no, Excel does not have a "Resize" event for the App window itself and you would need to go to APIs for that.
With the later Excel versions (past the 2010), there is ONE workbook per Excel Application window, the workbook's window is always maximized in the old sense, and both Workbook and Application events refer to the same workbook and would work just as you would want them to.
Solution , create a timer event that checks and compares the width every few seconds...
Sub my_ONTIME()
application.OnTime Now + TimeValue("00:00:2"), "my_TIMEREVENT"
End Sub
Sub my_TIMEREVENT()
If application.Width <> EWIDTHR Then ESCREENRESIZE
my_ONTIME
End Sub
Sub ESCREENRESIZE()
Dim EWIDTH As Single
Dim ESIDE As Single
Dim EMID As Single
EWIDTH = application.Width
EWIDTHR = EWIDTH
If EWIDTH < 500 Then
EWIDTH = 500
application.Width = 500
End If
EMID = 80 * 5.41
ESIDE = ((EWIDTH - EMID) / 2) / 5.41
Sheet1.Columns("A:A").ColumnWidth = ESIDE
Sheet1.Columns("C:C").ColumnWidth = ESIDE
End Sub
I have a keyboard hook that listens for [shift] + [F12] key button press to activate an edit mode in my program. By edit mode, I mean that any form that is inactive in the program window is disabled and focus is set to the active window. Furthermore, I alter the GUI to reflect that the user is running edit mode.
The purpose is of this all is to customize specific form controls that a user clicks on (e.g If they click on a label or combobox, a user would be able to edit the data that populates this information from a database). What I am really searching for is the ability to access the control name of the control that a user clicks on in the active form, DYNAMICALLY (without setting events on each form). Therefore, once a user clicks on a control such as a label, combo box, listview or listbox (on the active form), I would like to capture the control name clicked and pass that to another form that will handle the editing of this control.
You don't need to go to the trouble of using the API for what you want to do. All of the controls you mention expose a Click event. (If the control you want to use doesn't have a Click event, it almost certainly has a MouseDown event which will work just as well.) Just write a sub that takes the control as an argument and passes what info you want to the other form. Then in each of the controls (you can use control arrays for controls of the same type), call this sub. Something like this:
Sub DoTheWork(cCtl As Control)
Form2.CallSomeMethod(cCtl) 'Passes a reference to the entire control
Form2.CallSomeOtherMethod(cCtl.Name) 'Just passes the name
End Sub
Sub Command1_Click()
DoTheWork Command1
End Sub
Sub Label1_Click(Index As Integer) 'control array
DoTheWork Label1(Index)
End Sub
Now, if you really want to get involved in using SetWindowsHookEx and all that, here's a bit of annotated code that you can use to figure it out. This code allows you to change fonts on the MsgBox function, by substituting itself for any MsgBox call. (FYI, Microsoft implemented "CBT hooking" to support computer-based training back in the day, hence the term.)
'This code allows font changes and various other format customizations of the standard VB6 MsgBox dialog box. It
'uses CBT hooking to intercept an VB6-internal window call. In this case, it intercepts a MsgBox call, then gets
'a handle to the MsgBox window as well as its various child windows (the label containing the message text, any
'buttons, and an icon if it exists). It then resizes the window to accommodate the message text and other windows,
'and repositions the icon and any command buttons. Finally, it positions the msgbox window in the center of the
'screen.
'General Note: notes are above the line of code to which they apply.
Option Explicit
' Window size and position constants
Private Const ICON_WIDTH As Integer = 32
Private Const BTN_WIDTH As Integer = 75
Private Const BTN_HEIGHT As Integer = 23
Private Const BTN_SPACER As Integer = 6 ' Space between 2 buttons
Private Const STW_OFFSET As Integer = 12 ' Standard window offset, minimum distance one window can be from
' the edge of its container
' SendMessage constants that we will use
Private Const WM_SETFONT = &H30
Private Const WM_GETTEXT = &HD
' Necessary constants for CBT hooking
Private Const HCBT_CREATEWND = 3
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
' Working variables that require module-wide scope
Private hHook As Long
Private myFont As IFont
Private cPrompt As String
Private hwndStatic As Long
Private ButtonHandles() As Long
Private xPixels As Long
Private yPixels As Long
Private isIcon As Boolean
' The API Type declarations we need
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'GETTEXT needs a String argument for lParam, SETFONT needs an Any argument there, hence 2 declarations for SendMessageA
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageS Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
' Wrapper for the normal MsgBox function
Public Function myMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, ByVal fSize As Integer, ByVal fBold As Boolean, ByVal fItalic As Boolean, ByVal fULine As Boolean, fFaceName As String, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional x As Long, Optional y As Long) As Long
'x and y arguments are optional and are in twips. If not specified, msgbox will use default window sizes
'and positions, which work fine if you are using default font sizes. If you aren't they may not.
cPrompt = Prompt
Set myFont = New StdFont
With myFont ' We can make whatever adjustments we like here to the font
.SIZE = fSize
.Bold = fBold
.Italic = fItalic
.Underline = fULine
.Name = fFaceName
End With
'Convert x and y arguments to pixels from twips. (Twips are the same size no matter what the screen resolution; pixels aren't.)
If Not IsMissing(x) Then
xPixels = Int(x / Screen.TwipsPerPixelX)
End If
If Not IsMissing(y) Then
yPixels = Int(y / Screen.TwipsPerPixelY)
End If
'Set up the hook to catch windows messages, call CBTProc when there is one
hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, 0)
'This will call CBTProc, passing the handle of the MsgBox window to the wParam argument.
myMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
Dim statX As Integer 'X dimension of static (text) window
Dim statY As Integer 'Y dimension of same
Dim cLeft As Integer 'Current Left value for current button, used to position buttons along x axis
Dim rc As RECT 'Used with GetClientRect
If lMsg = HCBT_ACTIVATE Then
'Immediately unhook (we have the event we're looking for, and don't want to handle any more CBT events)
UnhookWindowsHookEx hHook
'Call EnumChildWindowProc once for each window that is contained in the MsgBox (each button and frame is a child window)
EnumChildWindows wParam, AddressOf EnumChildWindowProc, 0
'Reinitialize the static buttoncount variable, see the notes in the proc
EnumChildWindowProc 0, 1
'Should always be true, but this prevents an abend if for some reason we fail to get the text window
If hwndStatic Then
'If the x parameter has been supplied to the main wrapper, then xPixels <> 0
If xPixels <> 0 Then
With Screen
'Center the MsgBox window in the screen
SetWindowPos wParam, 0, (.Width / .TwipsPerPixelX - xPixels) / 2, _
(.Height / .TwipsPerPixelY - yPixels) / 2, xPixels, yPixels, 0
End With
'Analogous to the ScaleWidth and ScaleHeight properties. Client rectangle's dimensions are
'returned to the rc type and exclude the dimensions of the title bar and the borders.
GetClientRect wParam, rc
'Calculate x and y values for text window. If there's an icon, we need to reduce the size of the
'text window by the width of the icon plus a standard offset value.
statX = rc.Right - rc.Left - STW_OFFSET * 2 - ((isIcon And 1) * (ICON_WIDTH + STW_OFFSET))
statY = rc.Bottom - rc.Top - BTN_HEIGHT - STW_OFFSET * 2
'We need to position the text window along the x axis such that it's a standard offset from the left
'border of the msgbox, plus the width of the icon and another standard offset if the icon exists.
SetWindowPos hwndStatic, 0, STW_OFFSET + (isIcon And 1) * (ICON_WIDTH + STW_OFFSET), STW_OFFSET, statX, statY, 0
isIcon = 0
'Loop through the button handles, calculating the left border position each time.
For i = 0 To UBound(ButtonHandles)
'Current left border is half the container window's width, less the width of half the total
'number of buttons, plus the offset of the current button in the array.
cLeft = Int(xPixels / 2 + BTN_WIDTH * (i - (UBound(ButtonHandles) + 1) / 2))
'Modify the above to add button spacer widths.
cLeft = cLeft + BTN_SPACER * (i - (UBound(ButtonHandles) - 1) + (UBound(ButtonHandles) Mod 2) / 2)
'The Y value is 1 standard offset more than the height of the text window.
SetWindowPos ButtonHandles(i), 0, cLeft, statY + STW_OFFSET, BTN_WIDTH, BTN_HEIGHT, 0
Next
End If
SendMessage hwndStatic, WM_SETFONT, myFont.hFont, True
End If
End If
CBTProc = 0 ' allow operation to continue
End Function
Private Function EnumChildWindowProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Static ButtonCount As Integer
Dim sLen As Integer
Dim wClass As String
Dim wText As String
Dim rc As RECT
If lParam Then
ButtonCount = 0 'See the direct call of this proc in CBTProc: resets the ButtonCount variable to 0
Exit Function
End If
wClass = String(64, 0)
'look up the type of the current window
sLen = GetClassName(hChild, wClass, 63)
wClass = Left(wClass, sLen)
'We have either one or two static windows: optionally the icon (the first window if it's there) and the
'text window (analogous to a label control).
If wClass = "Static" Then
'If we already have the text window's handle, we don't need to do this anymore.
If Not hwndStatic Then
'Find out if the current window's text value is the same as the text passed in to the cPrompt
'argument in the main wrapper function. If it is, it's the text window and we store the handle
'value in hwndStatic. If it isn't, then it's an icon and we set the isIcon flag.
wText = String(Len(cPrompt) + 1, 0)
sLen = SendMessageS(hChild, WM_GETTEXT, 255, wText)
wText = Left(wText, sLen)
If wText = cPrompt Then
hwndStatic = hChild
Else
isIcon = True
End If
End If
ElseIf wClass = "Button" Then
'Store the button's handle in the ButtonHandles array
ReDim Preserve ButtonHandles(ButtonCount)
ButtonHandles(ButtonCount) = hChild
ButtonCount = ButtonCount + 1
End If
EnumChildWindowProc = 1 ' Continue enumeration
End Function
I need send mouse clicks from VBS. Like SendKeys. I have searched whole google, it seems there is no such function for VBS. Can you give me some solution?
Here is a routine to send a left or right click to a window (using relative references) in VBA for Excel. Similar to AppActivate, you just need the window title.
The arguments when you call the SendClick routine are:
Window Title (String)
Buttons (1 = Left, 2 = Right, -1 = Move mouse only; no click)
x (Relative position to window Left)
y (Relative position to window Top)
Enjoy!
'Declare mouse events
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public 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)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
'Declare sleep
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' Window location
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Function WindowHandle(ByVal sTitle As String) As Long
WindowHandle = FindWindow(vbNullString, sTitle)
End Function
Public Sub SendClick(sWnd As String, b As Integer, x As Long, y As Long)
Dim pWnd As Long, pRec As RECT
pWnd = WindowHandle(sWnd)
GetWindowRect pWnd, pRec
SetCursorPos pRec.Left + x, pRec.Top + y
Sleep 50
If b = 2 Then
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
ElseIf b <> -1 Then
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End If
End Sub
It's not possible with VBScript alone. You'll need to use a third-party tool like nircmd. You can use its setcursor, setcursorwin, movecursor, and sendmouse commands to manipulate the mouse.
For example, here's how to move the cursor to a screen coordinate (measured from the top left) and perform a right-click:
With CreateObject("WScript.Shell")
.Run "nircmd setcursor 100 100", 0, True
.Run "nircmd sendmouse right click", 0, True
End With
See the documentation for parameter information.
Try
Dim x
set x=createobject("wscript.shell")
x.sendkeys"{CLICK LEFT,50,60}"
or
x.SendKeys("+{F10}") 'for a right click
If neither of those work for you I would suggest using something like Autoit or autohotkey, using AutoHotKey you could write a macro that does the clicking and then call the script from your VBScript.
VBS is a script, not an application; VBScripts can call other applications or Component Objects to access elements of the host environment, just like batch files; eg. FileSystemObject to manipulate files.
There isn't one provided for mouse, so to move mouse or send mouse clicks, you'd need to call some app or COM object to do it, or make one.
Some apps that can manipulate the mouse are MSWord & MSExcel (via WinAPI calls), NirCmd, AutoIt, AutoHotKey, etc
Here's a VBApp example that calls functions of the User Component: user32.dll:
(Notice how the arguments are formatted before being sent to the DLL. This is not possible in VBS or batch files since they can only pass Strings as args; some functions expect data types eg. Int32, window handles or object references)
Option Strict On
Option Explicit On
Option Infer On
Imports System.Runtime.InteropServices
Public Class Mousing
Private Declare Auto Sub mouse_event Lib "user32" (ByVal dwFlags As Int32, ByVal dx As Int32, ByVal dy As Int32, ByVal cButtons As Int32, ByVal dwExtraInfo As IntPtr)
Private Const MOUSEEVENTF_LEFTDOWN As Int32 = &H2
Private Const MOUSEEVENTF_LEFTUP As Int32 = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
<StructLayout(LayoutKind.Sequential)>
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<DllImport("user32.dll")> _
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, EntryPoint:="FindWindow")> _
Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
Private Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
' find the window
Dim hWnd As IntPtr = FindWindow(Nothing, "Some Window")
' check if window found
If hWnd.Equals(IntPtr.Zero) Then
MessageBox.Show("Window Not Found!", "Aborting", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return ' exit
Else
' bring the window to the foreground
SetForegroundWindow(hWnd)
' get the windows size and location
Dim r As New RECT
GetWindowRect(hWnd, r)
'Move the cursor to the windows location plus our offset (x + 50 , y + 100)
Windows.Forms.Cursor.Position = New System.Drawing.Point(r.Left + 50, r.Top + 100)
' To move relative to screen, just enter coordinates above without offsetting
' click the left mouse button at the current mouse position
mouse_event(MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, IntPtr.Zero)
End If
End Sub
End Class
The following is a VBScript calling AutoIt to move mouse & click:
Set oAutoIt = WScript.CreateObject("AutoItX.Control")
set oShell = CreateObject("WScript.Shell")
oAutoIt.MouseMove x,y,0
WScript.Sleep 500
oAutoIt.MouseClick($MOUSE_CLICK_PRIMARY)
References:
http://www.vbforums.com/showthread.php?672196-RESOLVED-SetCursorPos
http://www.ericphelps.com/batch/rundll/
https://www.dostips.com/forum/viewtopic.php?t=3931
https://support.microsoft.com/en-au/help/152969/visual-basic-procedure-to-get-set-cursor-position
https://microsoft.public.scripting.vbscript.narkive.com/ZO09Cxnz/moving-mouse-pointer-with-vbs-file
I have a Rich Text Box control. It has no scroll bars, cause I am using Mouse Wheel module to capture Mouse Wheel events.
When the rich text box is selected and mouse wheel is rotated up/down it sends keys {UP} and {DOWN} to they rich text box to "mimic" the scroll effect.
However, when you are at the beginning or at the ending of the text box content (e.g there's nothing to scroll anymore), there's annoying beep system sound playing. I need to disable this, any ideas how to do that ?
Already tried adding this code in the rich text box's keypress event:
If KeyAscii = 38 Or KeyAscii = 40 Then
KeyAscii = 0
End If
Doesn't work. Don't know why it just doesn't work when it is supposed to be working.
Use the KeyDown event instead of KeyPress, and disable the KeyCode only if the cursor is located at the first/last line to prevent disabling the arrow keys (up/down) completely.
First you need to add the following to the declarations:
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_GETLINECOUNT = &HBA
Private Function GetCurrentLine(Txt As RichTextBox) As Long
GetCurrentLine = SendMessage(Txt.hWnd, EM_LINEFROMCHAR, Txt.SelStart, 0&) + 1
End Function
Private Function GetLineCount(Txt As RichTextBox) As Long
GetLineCount = SendMessage(Txt.hWnd, EM_GETLINECOUNT, 0&, 0&)
End Function
Then use the KeyDown event as described:
Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then
If GetCurrentLine(RichTextBox1) = 1 Then KeyCode = 0
ElseIf KeyCode = vbKeyDown Then
If GetCurrentLine(RichTextBox1) = GetLineCount(RichTextBox1) Then KeyCode = 0
End If
End Sub
Of course you'll need to replace RichTextBox1 with the name of your RichTextBox.
Hope that helps :)
Outside of a function/sub
Public Declare Function SendMessageByVal Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
In your sub/function
Ret = SendMessageByVal(gRtfHwnd, EM_SETEDITSTYLE, SES_ALLOWBEEPS + SES_USECRLF, SES_ALLOWBEEPS + SES_USECRLF)
To see more see http://ambracode.com/index/show/1405175 which is some copy of an old post I made at SO.
Just wondering if anyone know's how to remove scroll bars from a listbox in VB 6.0? As I want to add a 'global' scroll bar for multiple listboxes. I have searched online, but all of the solutions require the code to be placed in the click event of the list box.
You can hide the scrollbars using the Windows API. Here's a sample project to get you started. Add a ListBox (List1) to a form and add the following code:
Private Declare Function ShowScrollBar Lib "user32" _
(ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_VERT = 1
Private Sub HideVertScrollBar(LB As ListBox)
Call ShowScrollBar(LB.hwnd, SB_VERT, 0&)
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 25
List1.AddItem "Item " & i
Next
HideVertScrollBar List1
End Sub
Private Sub List1_Click()
HideVertScrollBar List1
End Sub
If you only call HideVertScrollBar in Form_Load, when you manually scroll (using the arrow keys), the scrollbar shows up again. We fix this by calling HideVertScrollBar in List1_Click as well.