set textbox cursor in mouse right-click

R

RB Smissaert

Is there an easy way to set the cursor in a textbox in the the mouse down
event when the right mouse button is used?
This is an ordinary textbox in a VBA userform, so I am not sure the Windows
API can help out here.

RBS
 
J

Jim Cone

RBS,
Assume you mean right-click on the UserForm...

Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then TextBox1.SetFocus
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"RB Smissaert" <[email protected]>
wrote in message
Is there an easy way to set the cursor in a textbox in the the mouse down
event when the right mouse button is used?
This is an ordinary textbox in a VBA userform, so I am not sure the Windows
API can help out here.
RBS
 
R

RB Smissaert

That sets the focus, but it doesn't put the cursor at the
mouse down position.
What I would like is do a right-mouse down, but make
it behave like a left-mouse down.

RBS
 
R

RB Smissaert

Forgot to say, I am talking about mouse-down in a textbox, not the userform.

RBS
 
P

Peter T

Hi Bart,

This seemed to work for me with no more testing than shown below. Not sure
about other implications, eg might want to flag and early exit other Textbox
events.

Private Declare Sub mouse_event Lib "user32" ( _
ByVal dwFlags As Long, ByVal dX As Long, _
ByVal dY As Long, ByVal dwData As Long, _
ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
'Dim mbExit As Boolean

Private Sub TextBox1_Mouseup(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Static bExit As Boolean

Debug.Print "Button"; Button, "bExit "; bExit

If bExit Then
bExit = False
Debug.Print "Exit Sub"
Debug.Print
Exit Sub
End If

If Button = 2 Then
bExit = True
MouseClick
End If

End Sub

Sub MouseClick()
Debug.Print "MouseClick"

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
DoEvents
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

End Sub

But this prevents the default right-click to 'select entire word' ?

Regards,
Peter T
 
P

Peter T

PS, I know you said MouseDown but when calling MouseClick the event appears
to want run three times. Would need to work out more carefully which to
catch and which to abort and flag correctly. I'll leave that to you!

Regards,
Peter T
 
R

RB Smissaert

Hi Peter,

Yes, somehow this should be the way to go.
As you say it is a bit fiddly and I haven't got it working properly yet.

RBS
 
P

Peter T

Never noticed before but Mousedown in a textbox normally appears to run
twice. Try this to call MouseClick in the 2nd time (button = 2) then abort
the third time it gets called because of the mouseclick API.

Private Sub TextBox1_Mousedown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Static nExit As Long

Debug.Print "Button"; Button, "nExit "; nExit

If nExit = 2 Then
nExit = False
Debug.Print "Exit Sub"
Debug.Print
Exit Sub
End If

If Button = 2 Then
nExit = nExit + 1
If nExit = 2 Then
'nExit = True
MouseClick
End If
ElseIf Button = 1 Then
Debug.Print nExit
' 0 normal left click
End If

End Sub

Regards,
Peter T
 
R

RB Smissaert

OK, got this worked out now:

In the form:

Private Sub MorbtxtReadCodeFrom_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Static btCount As Byte
If Button = 2 Then
If btCount Mod 2 = 0 Then
SendMouseLeftClick
End If
btCount = btCount + 1
End If
End Sub

In a module:

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos _
Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib _
"user32" (ByVal X As Long, ByVal Y As
Long) As Long

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_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_ABSOLUTE = &H8000


Sub SendMouseLeftClick(Optional ByVal lX As Long = -1, _
Optional ByVal lY As Long = -1)
'NOTE: lX and lY are assumed to be Screen coordinates
' relative to the uper left corner (0, 0)
'----------------------------------------------------
Dim lFlags As Long
Dim Point As POINTAPI
Dim bReturn As Boolean

'get the mouse cursor position to return to
GetCursorPos Point

'Set cursor position
If lX > -1 Then
SetCursorPos lX, lY
bReturn = True
Else
lX = Point.X
lY = Point.Y
End If

DoEvents

'Send the mouse event
lFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE
mouse_event lFlags, lX, lY, 0, 0
DoEvents

lFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE
mouse_event lFlags, lX, lY, 0, 0
DoEvents

'return to the old mouse position
If bReturn Then
SetCursorPos Point.X, Point.Y
DoEvents
End If

End Sub


The code that handles the Mouse Up with right button is in a class module,
handling some 100 textboxes.
Only a few of them need the extra mouse left click, so these are handled in
the form.
I am not interested in the right-click selecting a whole word, so that is
fine as it is.


RBS
 
P

Peter T

Some sloppy code there (editing the previous bExit > nExit)
nExit = False
Click to expand...
should be of course nExit = 0

Looks like you've implemented similar logic, I think.

Regards,
Peter
 
R

RB Smissaert

This is a bit better:

Private Sub MorbtxtReadCodeFrom_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Static bDone As Boolean
If Button = 2 Then
If bDone = False Then
bDone = True
SendMouseLeftClick
Else
bDone = False
End If
End If
End Sub

Yes, I knew about the Mouse down being triggered twice. That is why I use
the Mouse up, except in this
case I need the Mouse down to position the cursor before the Mouse Up event
happens.


RBS
 
R

RB Smissaert

And this is a bit better to reduce the amount of extra code:

Sub SetCursorInTextboxRightMouseDown(iButton As Integer)
Static bDone As Boolean
If iButton = 2 Then
If bDone = False Then
bDone = True
SendMouseLeftClick
Else
bDone = False
End If
End If
End Sub

And in the form:

Private Sub MorbtxtReadCodeFrom_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
SetCursorInTextboxRightMouseDown Button
End Sub


I think that should settle it.


RBS
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

TextBox Focus And Active Cursor Movement In User Forms 2
UserForm - Right-click a Textbox and Paste 1
vba macro that allows insertion of symbols at cursor 0
Cursor disappears / Cursor verschwindet 1
Userform textbox string to header causes unwanted double spacing 4
Firing Event in another user form 1
Copy value of textbox to clipboard for use in another application 5
adding right click menu to textbox 3

Top