Results 1 to 9 of 9

Thread: [VB6] - Multi-line standard tooltip.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,590

    [VB6] - Multi-line standard tooltip.


    Standard tooltip (property "ToolTipText" of controls) does not support multi-line text and displays all the text on one line. Suggest module that supports "multiline" standard tooltip based on subclassing windows tooltip. Can, in principle, and the color and design to change the tooltip if you wish, I left the standard; You can also add width adjustment (so as not to produce a lot of code I left centered), commented on almost every line. Button to stop the project after the launch of "hook" can not be otherwise crash IDE (I have Win7 (64), not falling apart; always took off on XP), it is necessary to close the window and call "Unhook".

    MultilineTooltip_eng.zip

  2. #2
    Addicted Member
    Join Date
    Aug 2016
    Posts
    222

    Re: [VB6] - Multi-line standard tooltip.

    I tried few methods either by a resource file or manifest, but I can't get themed tooltips. Are you using hard code to draw tooltips?

    Code:
    Case WM_PAINT
            BeginPaint hwnd, ps                                                                 
            md = GetBkMode(ps.hdc)                                                              
            oft = SelectObject(ps.hdc, hFont)                                                 
            SetBkMode ps.hdc, TRANSPARENT                                                       
            DrawText ps.hdc, s, Len(s), RC, DT_WORDBREAK Or DT_CENTER                           
            SelectObject ps.hdc, oft                                                            
            SetBkMode ps.hdc, md                                                             
            EndPaint hwnd, ps                                                                   
            Exit Function

  3. #3
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,546

    Re: [VB6] - Multi-line standard tooltip.

    Once you're doing drawing yourself like that, shouldn't you simply be able to use the Theme API? Mainly the DrawThemeBackground function...
    Code:
    TOOLTIP	TTP_BALLOON	TTBS_LINK, TTBS_NORMAL
    	TTP_BALLOONSTEM	TTBSS_POINTINGUPLEFTWALL, TTBSS_POINTINGUPCENTERED, TTBSS_POINTINGUPRIGHTWALL, TTBSS_POINTINGDOWNRIGHTWALL, TTBSS_POINTINGDOWNCENTERED, TTBSS_POINTINGDOWNLEFTWALL
    	TTP_BALLOONTITLE	
    	TTP_CLOSE	TTCS_HOT, TTCS_NORMAL, TTCS_PRESSED
    	TTP_STANDARD	TTSS_LINK, TTSS_NORMAL
    	TTP_STANDARDTITLE	TTSS_LINK, TTSS_NORMAL
    	TTP_WRENCH (Windows 7)	TTWS_NORMAL, TTWS_HOT, TTWS_PRESSED
    Theme Parts and States (MSDN)

  4. #4
    Addicted Member
    Join Date
    Aug 2016
    Posts
    222

    Re: [VB6] - Multi-line standard tooltip.

    Quote Originally Posted by fafalone View Post
    Once you're doing drawing yourself like that, shouldn't you simply be able to use the Theme API? Mainly the DrawThemeBackground function...
    Code:
    TOOLTIP	TTP_BALLOON	TTBS_LINK, TTBS_NORMAL
    	TTP_BALLOONSTEM	TTBSS_POINTINGUPLEFTWALL, TTBSS_POINTINGUPCENTERED, TTBSS_POINTINGUPRIGHTWALL, TTBSS_POINTINGDOWNRIGHTWALL, TTBSS_POINTINGDOWNCENTERED, TTBSS_POINTINGDOWNLEFTWALL
    	TTP_BALLOONTITLE	
    	TTP_CLOSE	TTCS_HOT, TTCS_NORMAL, TTCS_PRESSED
    	TTP_STANDARD	TTSS_LINK, TTSS_NORMAL
    	TTP_STANDARDTITLE	TTSS_LINK, TTSS_NORMAL
    	TTP_WRENCH (Windows 7)	TTWS_NORMAL, TTWS_HOT, TTWS_PRESSED
    Theme Parts and States (MSDN)
    Thanks. I got it.

  5. #5
    Addicted Member
    Join Date
    Feb 2015
    Location
    Colorado USA
    Posts
    134

    Re: [VB6] - Multi-line standard tooltip.

    Trick,

    I run 64-bit Windows 10. I can't get your sample program to work correctly in the IDE. It works fine as a compiled EXE but in the IDE each of the tooltips flash once and then don't show. But even stranger, the one string S(2) in your form load that has 7 lines of text sometimes displays and stays displayed but none of the others ever remain displayed. Is this intentional?

    Also, I am guessing that the comments in your code are in cyrillic but since I don't have that as an ANSI code page I can't translate them. Would it be possible to save your two code files in UTF-8 so that we can see and then translate your comments? Thanks.

  6. #6

  7. #7
    Addicted Member
    Join Date
    Feb 2015
    Location
    Colorado USA
    Posts
    134

    Re: [VB6] - Multi-line standard tooltip.

    Thanks for the comment translations. However, I am still getting the same performance of the tooltips in the IDE. the 7-line one generally stays displayed but the others just appear momentarily. That doesn't happen when executing the program outside the IDE.

  8. #8
    Addicted Member shagratt's Avatar
    Join Date
    Jul 2019
    Location
    Argentina
    Posts
    129

    Re: [VB6] - Multi-line standard tooltip.

    I Made this changes to remove the limit of the 255 chars size and to create a newline with "///" so multiline tooltips can be easy edited from the designer window.


    Added code in Bold:

    Code:
    ' Tooltip window proc
    Private Function ToolProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim ps As PAINTSTRUCT, oft As Long, wp As WINDOWPOS, dc As Long, md As Long, bw As Long, bh As Long
        Dim ii As ICONINFO, bm As BITMAP, pt As POINTAPI, hIcon As Long
        
        Select Case Msg
        Case WM_SETTEXT                                                                         ' Before tooltip is showed it receives WM_SETTEXT
            l = lstrlen(ByVal lParam)                                                           ' Get text length
            If l Then                                                                           ' Check for empty stirng
                s = Space(l)                                                                    ' Allocate enough buffer
                lstrcpy ByVal s, ByVal lParam                                                   ' Copy string to buffer
                
                'Get the full tooltip text from the control
                If (Len(s) > 254) Then
                    s = GetFullTooltipText(GetForegroundWindow, s)
                End If
                
                'Allow to type newlines easy in the property windows directly
                s = Replace$(s, "///", vbNewLine)
                
                bw = GetSystemMetrics(SM_CXBORDER): bh = GetSystemMetrics(SM_CYBORDER)          ' Get border sizes
                dc = GetDC(0)                                                                   ' Acuire context to calculate string boundaries
                oft = SelectObject(dc, hFont)                                                   ' Select tooltip font
                SetRect RC, 0, 0, 0, 0                                                          ' Reset rectangle of view
                DrawText dc, s, Len(s), RC, DT_CALCRECT                                         ' Calculate text boundaries
                OffsetRect RC, bw * 2, bh * 2                                                   ' Offset to double border size
                w = bw * 4 + RC.iRight: h = bh * 4 + RC.iBottom                                 ' Calculate window size
                
                If MaxWidth > 32 And w > MaxWidth Then                                          ' If width is greater than specified
                    SetRect RC, bw * 2, bh * 2, MaxWidth, h                                     ' Correct boundaries
                    DrawText dc, s, Len(s), RC, DT_CALCRECT Or DT_WORDBREAK                     ' Calculate text boundaries taking into account line breaks
                    w = bw * 4 + RC.iRight: h = bh * 4 + RC.iBottom                             ' Calculate window size
                End If
                
                
                SelectObject dc, oft                                                            ' Restore state
                ReleaseDC 0, dc                                                                 ' Release context
                ToolProc = True                                                                 ' Success
                Exit Function
            End If
        Case WM_WINDOWPOSCHANGING                                                               ' Before resizing
            CopyMemory wp, ByVal lParam, Len(wp)                                                ' Get the size and position
            wp.cx = w: wp.cy = h                                                                ' Assign the width and height which we got
            hIcon = GetCursor()                                                                 ' Get current cursor handle
            GetIconInfo hIcon, ii                                                               ' Get cursor info
            GetObject ii.hbmColor, Len(bm), bm                                                  ' Get cursor picture info
            bw = (bm.bmWidth + ii.xHotspot) \ 2                                                 ' Calculate half-offset to window
            bh = (bm.bmHeight + ii.yHotspot) \ 2
            GetCursorPos pt                                                                     ' Get cursor position
            
            If pt.x + w + bw > Screen.Width \ Screen.TwipsPerPixelX Then                        ' If window is out of bounds
                wp.x = pt.x - w - bw                                                            ' Correct position
            Else                                                                                ' //
                wp.x = pt.x + bw                                                                ' //
            End If
            If pt.y + h + bh > Screen.Height \ Screen.TwipsPerPixelY Then                       ' //
                wp.y = pt.y - h - bh                                                            ' //
            Else                                                                                ' //
                wp.y = pt.y + bh                                                                ' //
            End If
            
            CopyMemory ByVal lParam, wp, Len(wp)                                                ' Update
            Exit Function
        Case WM_PAINT
            BeginPaint hwnd, ps                                                                 ' Prepare window to redraw
            md = GetBkMode(ps.hdc)                                                              ' Get background style to restore it in further
            oft = SelectObject(ps.hdc, hFont)                                                   ' Select font
            SetBkMode ps.hdc, TRANSPARENT                                                       ' Set transparent text background
            DrawText ps.hdc, s, Len(s), RC, DT_WORDBREAK Or DT_CENTER                           ' Draw text with center justifying
            SelectObject ps.hdc, oft                                                            ' Restore context
            SetBkMode ps.hdc, md                                                                ' //
            EndPaint hwnd, ps                                                                   ' All is done
            Exit Function
        End Select
        ToolProc = CallWindowProc(lpPrev, hwnd, Msg, wParam, lParam)                            ' Process others by default
    End Function
    
    
    Private Function GetFullTooltipText(FrmHwnd&, PartialT$) As String
    On Error Resume Next
    Dim PTL&: PTL = Len(PartialT$)
        
        Dim f As Form, c As Control
        For Each f In Forms
            If (f.hwnd = FrmHwnd&) Then
                For Each c In f
                    If (Left(c.ToolTipText, PTL) = PartialT) Then
                        GetFullTooltipText = c.ToolTipText
                        Exit Function
                    End If
                Next
            End If
        Next
        'Not found? return partial text
        GetFullTooltipText = PartialT$
    End Function

  9. #9

Tags for this Thread

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