[RESOLVED] how can i make a control follow the mouse pointer?
hey
i am trying to make a textbox follow the mouse pointer but somehow it's awkward
when i go right with the mouse it goes left
when i go left it goes right
any ideas?
this is the code i use
Code:
Private Sub CalendarControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Text1
.Left = X + 1000
.Top = Y + 200
.Height = 0
.Width = 2500
.BackColor = vbYellow
.Visible = True
End With
End Sub
Re: how can i make a control follow the mouse pointer?
Not at all sure what you're trying to do, but I just threw this together, and it does what your title describes.
Just a Form1 with a Text1 throw onto it.
And code for Form1:
Code:
Option Explicit
'
Private Type POINTAPI
X As Long
Y As Long
End Type
'
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static OldMousePos As POINTAPI
Dim MousePos As POINTAPI
GetCursorPos MousePos
If MousePos.X = OldMousePos.X And MousePos.Y = OldMousePos.Y Then Exit Sub
OldMousePos = MousePos
'
Text1.Left = X - Text1.Width / 2
Text1.Top = Y - Text1.Height / 2
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Form_MouseMove Button, Shift, X + Text1.Left, Y + Text1.Top
End Sub
I put the little GetCursorPos test in there to knock out any possibility of jitter.
Enjoy,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: how can i make a control follow the mouse pointer?
Ahhh, I'd use a custom form (not control) to do something like that. That way, it's entirely independent of the form you're working with. I do that in a few places in my primary app.
However, Windows already has a fairly nice ToolTip capability built in. Here's "wrapper" code for a BAS module that I use to use it:
Code:
Option Explicit
'
Public Type RECT
Left As Long
Top As Long
Right As Long ' This is +1 (right - left = width)
Bottom As Long ' This is +1 (bottom - top = height)
End Type
'
Private Type TOOLINFO
lSize As Long
lFlags As Long
hWnd As Long
lId As Long
lpRect As RECT
hInstance As Long
lpStr As String
lParam As Long
End Type
'
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
'
Private Const WM_USER = &H400
Private Const CW_USEDEFAULT = &H80000000
'
Private Const TTM_ACTIVATE = WM_USER + 1
Private Const TTM_ADDTOOLA = WM_USER + 4
Private Const TTM_SETDELAYTIME = WM_USER + 3
Private Const TTM_UPDATETIPTEXTA = WM_USER + 12
Private Const TTM_SETTIPBKCOLOR = WM_USER + 19
Private Const TTM_SETTIPTEXTCOLOR = WM_USER + 20
Private Const TTM_SETMAXTIPWIDTH = WM_USER + 24
Private Const TTM_SETTITLE = WM_USER + 32
'
Private Const TTS_NOPREFIX = &H2
Private Const TTS_BALLOON = &H40
Private Const TTS_ALWAYSTIP = &H1
'
Private Const TTF_CENTERTIP = &H2
Private Const TTF_IDISHWND = &H1
Private Const TTF_SUBCLASS = &H10
Private Const TTF_TRANSPARENT = &H100
'
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3
'
Private Const TOOLTIPS_CLASSA = "tooltips_class32"
'
Public Enum ttIconType
TTNoIcon = 0
TTIconInfo = 1
TTIconWarning = 2
TTIconError = 3
End Enum
#If False Then ' Intellisense fix.
Public TTNoIcon, TTIconInfo, TTIconWarning, TTIconError
#End If
'
Private hwndTT As Long ' hwnd of the tooltip
'
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Public Sub CreateToolTip(ByVal ParentHwnd As Long, _
ByVal TipText As String, _
Optional ByVal uIcon As ttIconType = TTNoIcon, _
Optional ByVal sTitle As String, _
Optional ByVal lForeColor As Long = -1, _
Optional ByVal lBackColor As Long = -1, _
Optional ByVal bCentered As Boolean, _
Optional ByVal bBalloon As Boolean, _
Optional ByVal lWrapTextLength As Long = 50, _
Optional ByVal lDelayTime As Long = 200, _
Optional ByVal lVisibleTime As Long = 5000)
'
' If lWrapTextLength = 0 then there will be no wrap.
' Also, lWrapTextLength = 40 is a minimum value.
' The max for lVisibleTime is 32767.
'
Static bCommonControlsInitialized As Boolean
Dim lWinStyle As Long
Dim ti As TOOLINFO
'
If Not bCommonControlsInitialized Then
InitCommonControls
bCommonControlsInitialized = True
End If
'
' Destroy any previous tooltip.
If hwndTT <> 0 Then DestroyWindow hwndTT
'
' Format the text.
FormatTooltipText TipText, lWrapTextLength
'
' Initial style settings.
lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
If bBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON ' Create baloon style if desired.
' Set the style.
hwndTT = CreateWindowEx(0&, TOOLTIPS_CLASSA, vbNullString, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0&, 0&, App.hInstance, 0&)
'
' Setup our tooltip info structure.
ti.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
If bCentered Then ti.lFlags = ti.lFlags Or TTF_CENTERTIP
' Set the hwnd prop to our parent control's hwnd.
ti.hWnd = ParentHwnd
ti.lId = ParentHwnd
ti.hInstance = App.hInstance
ti.lpStr = TipText
ti.lSize = LenB(ti)
' Set the tooltip structure
SendMessage hwndTT, TTM_ADDTOOLA, 0&, ti
SendMessage hwndTT, TTM_UPDATETIPTEXTA, 0&, ti
'
' Colors.
If lForeColor <> -1 Then SendMessage hwndTT, TTM_SETTIPTEXTCOLOR, lForeColor, 0&
If lBackColor <> -1 Then SendMessage hwndTT, TTM_SETTIPBKCOLOR, lBackColor, 0&
'
' Title or icon.
If uIcon <> TTNoIcon Or sTitle <> vbNullString Then SendMessage hwndTT, TTM_SETTITLE, CLng(uIcon), ByVal sTitle
'
SendMessageLong hwndTT, TTM_SETDELAYTIME, TTDT_AUTOPOP, lVisibleTime
SendMessageLong hwndTT, TTM_SETDELAYTIME, TTDT_INITIAL, lDelayTime
End Sub
Public Sub DestroyToolTip()
' It's not a bad idea to put this in the Form_Unload event just to make sure.
If hwndTT <> 0 Then DestroyWindow hwndTT
hwndTT = 0
End Sub
Private Sub FormatTooltipText(TipText As String, lLen As Long)
Dim s As String
Dim i As Long
'
' Make sure we need to do anything.
If lLen = 0 Then Exit Sub
If lLen < 40 Then lLen = 40
If Len(TipText) <= lLen Then Exit Sub
'
Do
i = InStrRev(TipText, " ", lLen + 1)
If i = 0 Then
s = s & Left$(TipText, lLen) & vbCrLf ' Build "s" and trim from TipText.
TipText = Mid$(TipText, lLen + 1)
Else
s = s & Left$(TipText, i - 1) & vbCrLf ' Build "s" and trim from TipText.
TipText = Mid$(TipText, i + 1)
End If
If Len(TipText) <= lLen Then
TipText = s & TipText ' Place "s" back into TipText and get out.
Exit Sub
End If
Loop
End Sub
And then, to play with it in a small isolated example, I just put a single ListBox (List1) on the Form1, and then added the following code to Form1:
Code:
Option Explicit
Private Sub Form_Load()
List1.AddItem "asdfasdfasdfasdfasdf"
List1.AddItem "qwerqwerqwerqwreqwerqwerqw"
List1.AddItem "zxcvzxcvzxcvzxcvzxcvzxcv"
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyToolTip
End Sub
Private Sub List1_Click()
CreateToolTip List1.hWnd, List1.List(List1.ListIndex), , , , &H80FFFF, , , , 0
End Sub
I'll let you "discover" what the different options do when you call that CreateToolTip procedure.
Enjoy,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: how can i make a control follow the mouse pointer?
Originally Posted by salsa31
hey
i am trying to make a textbox follow the mouse pointer but somehow it's awkward
when i go right with the mouse it goes left
when i go left it goes right
any ideas?
this is the code i use
Code:
Private Sub CalendarControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Text1
.Left = X + 1000
.Top = Y + 200
.Height = 0
.Width = 2500
.BackColor = vbYellow
.Visible = True
End With
End Sub
tnx for any help
salsa
Re-arrange your codes a bit to get rid of the jerkiness, by doing the move after the settings. It works fine at my end. See attached video.
Re: how can i make a control follow the mouse pointer?
Originally Posted by salsa31
Elroy,a little complicated for me
any thing simple?
Hi salsa31,
Hmmm, I actually thought my ToolTip code was pretty simple, at least in terms of usage. Here's the "usage/example" code again:
Code:
Option Explicit
Private Sub Form_Load()
List1.AddItem "asdfasdfasdfasdfasdf"
List1.AddItem "qwerqwerqwerqwreqwerqwerqw"
List1.AddItem "zxcvzxcvzxcvzxcvzxcvzxcv"
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyToolTip
End Sub
Private Sub List1_Click()
CreateToolTip List1.hWnd, List1.List(List1.ListIndex), , , , &H80FFFF, , , , 0
End Sub
I try my best to write my wrappers such that they're as simple as possible. If you'll study that CreateToolTip procedure (in the above BAS module, post #4), you'll notice that all but the ParentHwnd and TipText are optional. If you want to use it in a "simple" fashion, just call it with only those two arguments.
Best Of Luck,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: how can i make a control follow the mouse pointer?
chosk great video thank you
tnx Elroy
chosk a little problem
when i move the mouse to the right the text goes left
when i move the mouse to the left the text goes right
only in the middle of the screen it is ok
Last edited by salsa31; Feb 20th, 2018 at 11:49 AM.
Re: how can i make a control follow the mouse pointer?
I guess the question is what is CalendarControl and what are its scale parameters.
It sounds like it has the X values reversed, i.e. that the scalewidth is a negative number.
I don't think anyone else who has experimented with code in this thread has a control with a negative scalewidth and the code works fine for them (as is in post #1, actually).
Is it possible you're working with a Right to Left orientation in coordinates in windows itself?
Re: how can i make a control follow the mouse pointer?
Is it possible you're working with a Right to Left orientation in coordinates in windows itself
yes sir
I guess the question is what is CalendarControl and what are its scale parameters.
there is some code in the form resize
Code:
If FrmMainMenu.WindowState <> 2 Then Exit Sub
On Error Resume Next
Dim nHeight As Long, LabelWidth As Long
nHeight = Height - 255 * 1.5 - CalendarControl.Top - 9 * Screen.TwipsPerPixelY
If nHeight < 0 Then Height = 0
If LabelWidth < 0 Then LabelWidth = 0
CalendarControl.Move 0, CalendarControl.Top
Re: how can i make a control follow the mouse pointer?
Originally Posted by passel
I don't think anyone else who has experimented with code in this thread has a control with a negative scalewidth
Hmmm, I didn't explore the entire context of this statement, but I do often use a negative ScaleHeight. I often like to use PictureBoxes like a coordinate system (possibly with origin in lower-left, rather than upper-left, or possibly even with origin in the center). The easiest way to put the origin at lower-left is to negate the ScaleHeight and then make the ScaleTop the positive of that value.
Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Re: [RESOLVED] how can i make a control follow the mouse pointer?
This is marked resolved, so I guess it is resolved?
Anyway, I didn't mean that anyone responding to this thread hasn't used inverted user scaling before. I meant none of the code posted in this thread is addressing inverted scaling. Since the original code works fine for me, but the OP said it moves in the opposite direction when he moves the mouse, the only reason I can think that would be the case is if the coordinate system is reversed between what the CalendarControl is using (he's referencing its X,Y mouse values) compared to the X,Y values the Textbox's container is using.