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".
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.
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.
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
With The Trick's approval, I have made the following additions to his code:
- All Windows API calls are Unicode.
- Added shagratt's suggested addition (post #8) for removing max length of tooltip.
- Added shagratt's suggested addition (post #8) to use /// in tooltip to denote a vbNewLine.
- Changed public procedure names: Hook to ToolTipHook, UnHook to ToolTipUnHook to avoid potential naming conflicts with other modules.
- Made module-level variables private to avoid possible collision with variables in other modules.
- Added public variable MLToolTipsOnlyIfCompiled that, if True, restricts the use of the hook to non-IDE (compiled) programs.
- Took out alias for RtlMoveMemory and switched calls to CopyMemory to RtlMoveMemory (personal preference).
- Changed capitalization of some variable names.
- Changed variable name lpPrev to PrevWinProc (made more sense to me).
I haven't worked on theming yet (see posts 2, 3 and 4) but when I get some time I'll add that.
I like to use this to complete Krool's work to make my app fully Unicode supporting. However, both compiled and in IDE the Unicode text that has been assigned to the tooltips shows as questionmarks only. (I tried with Russian and Thai on XP and Win10. Standard VB6 toolbar, and Krool's CommandButtonW.)
Do I need to do something special when assigning the Unicode texts to the tooltip properties?
I like to use this to complete Krool's work to make my app fully Unicode supporting. However, both compiled and in IDE the Unicode text that has been assigned to the tooltips shows as questionmarks only. (I tried with Russian and Thai on XP and Win10. Standard VB6 toolbar, and Krool's CommandButtonW.)
Do I need to do something special when assigning the Unicode texts to the tooltip properties?
frm files stores all the string properties as ANSI. Please attach a small example.
The Unicode texts are read from an UTF-16 file at runtime, and stored in a Class/collection.
When a form is opened, the translated texts are assigned to each of the controls on the form. Here is part of the code that handles that:
Code:
With g_oTranslationCol.Item(i)
If .Index = -1 Then
'Form, replace caption
DefWindowProcW oForm.hWnd, &HC, 0&, StrPtr(.TranslatedText) ' &HC = WM_SetText
ElseIf .Index = 0 Then
'Single control, replace caption
If (TypeOf oForm.Controls.Item(sControlName) Is Menu) Then
'Skip
Else
oForm.Controls.Item(sControlName).Caption = .TranslatedText
End If
ElseIf .Index > 100 And .Index < 1000 Then
'Toolbar control, replace tooltip texts of button; remove last 3 characters used to make control ID unique
sControlName = Left(sControlName, Len(sControlName) - 3)
oForm.Controls.Item(sControlName).Buttons(.Index - 100).ToolTipText = .TranslatedText 'buttons array starts at 1, so no correction is needed
ElseIf .Index > 1000 And .Index < 10000 Then
'Tab control, replace tab-captions; remove last 4 characters used to make control ID unique
sControlName = Left(sControlName, Len(sControlName) - 4)
oForm.Controls.Item(sControlName).TabCaption(.Index - 1000 - 1) = .TranslatedText 'tab array starts at 0, so correction is needed
End If
End With
Using Krool's Common Controls Replacement objects, translations are applied without any problem to controls, but the tooltip only shows questionmarks. See picture. (Note: two screen captures combined in one picture, as the tooltip is not displayed when the dialog is open (in vbModal mode).)
I could not make display Unicode to any of the two projects, I get all question marks.
I think when you assign a text to the VB ToolTipText property of an Extender, it must be converted to ANSI, but I'm not sure (since you say it works).
Test project attached, with some Chinese text.
This issue of the tool tips seems to be a stopper for full implementing Unicode with Krool's controls.
OK, my question was quite some time ago, and at that stage I was experimenting with Unicode to figure out how to best deal with it. I can't remember what in the end the problem was, but my translations are now stored in UTF-8 files, and read into memory (a collection) with a specific routine. Assigning Unicode tooltips to the CCR Toolbar runs smoothly using the following code:
Code:
For Each oButton In oControl.Buttons
'Toolbar control, replace tooltip texts of button
sTranslationID = oForm.Name & "." & sControlName & "." & oButton.Key
If Not g_oTranslationCol.Item(sTranslationID) Is Nothing Then
oButton.ToolTipText = g_oTranslationCol.Item(sTranslationID).TranslatedText
End If
Next
I took the liberty to enhance The original module so it supports unicode text, and remove the 255-characters limit.
I did so by allocating a pointer to store the unicode string, and save the pointer as the control's tooltiptext.
When drawing, retrieve the string from pointer, and draw using DrawTextW.
I didn't ask permission from the owner though. (Should I?)
If anyone is interested, I will post the enhanced module.
I took the liberty to enhance The original module so it supports unicode text, and remove the 255-characters limit.
I did so by allocating a pointer to store the unicode string, and save the pointer as the control's tooltiptext.
When drawing, retrieve the string from pointer, and draw using DrawTextW.
I didn't ask permission from the owner though. (Should I?)
If anyone is interested, I will post the enhanced module.
I took the liberty to enhance The original module so it supports unicode text, and remove the 255-characters limit.
I did so by allocating a pointer to store the unicode string, and save the pointer as the control's tooltiptext.
When drawing, retrieve the string from pointer, and draw using DrawTextW.
I didn't ask permission from the owner though. (Should I?)
If anyone is interested, I will post the enhanced module.
Yes of course. On the contrary, I'm glad that the module is being improved.
Where Alignment can be 0,1,2 (Left,Center,Right)
Add 4 for Right-To-Left text (4,5,6)
There is also an automate function to load an entire form's control's unicode tooltiptext, given the original codepage of your form.
This will work even if the destination computer has a different codepage!
Code:
LoadTTT frm, CP
Get tooltiptext:
Code:
myStr = UniToolTip(ctl)
On Form_Unload (important!):
Code:
UnhookTTT
FreeTTT Me
FreeTTT is to free the memory allocated for strings.
You can also use:
Code:
UniToolTip(ctl) = ""
to free the memory.
Every time you call HookTTT (e.g. calling in different forms), an internal counter is increased.
When you call UnhookTTT, the counter is decreased, and when reached 0 - the hook is removed.
To force hook removal - set parameter force to true.