Results 1 to 14 of 14

Thread: [RESOLVED] how can i make a control follow the mouse pointer?

  1. #1

    Thread Starter
    Enjoy the moment
    Join Date
    Feb 2011
    Location
    Barrio Del pilar madrid spain
    Posts
    5,204

    Resolved [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
    tnx for any help
    salsa

  2. #2
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    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.

  3. #3

    Thread Starter
    Enjoy the moment
    Join Date
    Feb 2011
    Location
    Barrio Del pilar madrid spain
    Posts
    5,204

    Re: how can i make a control follow the mouse pointer?

    i want to make like a custom tooltip
    need the text to be under the mouse pointer
    i tried some traps error
    any chance for something easier?
    Last edited by salsa31; Feb 19th, 2018 at 04:26 PM.

  4. #4
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    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.

  5. #5

    Thread Starter
    Enjoy the moment
    Join Date
    Feb 2011
    Location
    Barrio Del pilar madrid spain
    Posts
    5,204

    Re: how can i make a control follow the mouse pointer?

    Elroy,a little complicated for me
    any thing simple?

  6. #6
    gibra
    Guest

    Re: how can i make a control follow the mouse pointer?

    Quote Originally Posted by salsa31 View Post
    any thing simple?
    What you are asking for is not simple.

  7. #7
    Hyperactive Member
    Join Date
    Feb 2014
    Posts
    278

    Re: how can i make a control follow the mouse pointer?

    Quote Originally Posted by salsa31 View Post
    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.
    Attached Files Attached Files

  8. #8
    Hyperactive Member
    Join Date
    Feb 2014
    Posts
    278

    Re: how can i make a control follow the mouse pointer?

    I am doing something similar, except using Label and info updating. See attached video.
    Attached Files Attached Files

  9. #9
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: how can i make a control follow the mouse pointer?

    Quote Originally Posted by salsa31 View Post
    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.

  10. #10

    Thread Starter
    Enjoy the moment
    Join Date
    Feb 2011
    Location
    Barrio Del pilar madrid spain
    Posts
    5,204

    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.

  11. #11
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    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?

  12. #12

    Thread Starter
    Enjoy the moment
    Join Date
    Feb 2011
    Location
    Barrio Del pilar madrid spain
    Posts
    5,204

    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

  13. #13
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: how can i make a control follow the mouse pointer?

    Quote Originally Posted by passel View Post
    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.

  14. #14
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width