I found a hidden bug in MS tooltips class. If the toolstip set to TTS_BALLOON, the tooltips re-position (twice) in usercontrol only when themed (manifest) applied. But if the tooltips style is standard, the flicker goes off.
Please refer to my attachment. Compiled first. Run the exe file. Mouse moving over button from top to bottom, you can see balloon tooltips flickering. Is MS wrong or jcButton wrong?
Attachment 95319
I do think the original CreateToolTips function is ok. The problem is hidden. I haven't found the root cause.
Please refer to my attachment. Compiled first. Run the exe file. Mouse moving over button from top to bottom, you can see balloon tooltips flickering. Is MS wrong or jcButton wrong?
Attachment 95319
I do think the original CreateToolTips function is ok. The problem is hidden. I haven't found the root cause.
Code:
Private Sub CreateToolTip()
'****************************************************************************
'* A very nice and flexible sub to create balloon tool tips
'* Author :- Fred.CPP
'* Added as requested by many users
'* Modified by me to support unicode
'* Thanks Alfredo ;)
'****************************************************************************
Dim lpRect As RECT
Dim lWinStyle As Long
Dim lPtr As Long
Dim ttip As TOOLINFO
Dim ttipW As TOOLINFOW
Const CS_DROPSHADOW As Long = &H20000
Const GCL_STYLE As Long = (-26)
' --Dont show tooltips if disabled
If (Not m_bEnabled) Or m_bPopupShown Or m_Buttonstate = eStateDown Then Exit Sub
' --Destroy any previous tooltip
If m_lttHwnd <> 0 Then
DestroyWindow m_lttHwnd
End If
lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
''create baloon style if desired
If m_lTooltipType = TooltipBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON
If m_bttRTL Then
m_lttHwnd = CreateWindowEx(WS_EX_LAYOUTRTL, TOOLTIPS_CLASSA, vbNullString, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, UserControl.hWnd, 0&, App.hInstance, 0&)
Else
m_lttHwnd = CreateWindowEx(0&, TOOLTIPS_CLASSA, vbNullString, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, UserControl.hWnd, 0&, App.hInstance, 0&)
End If
SetClassLong m_lttHwnd, GCL_STYLE, GetClassLong(m_lttHwnd, GCL_STYLE) Or CS_DROPSHADOW
'make our tooltip window a topmost window
' This is creating some problems as noted by K-Zero
'SetWindowPos m_lttHwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
''get the rect of the parent control
GetClientRect UserControl.hWnd, lpRect
If m_WindowsNT Then
' --set our tooltip info structure for UNICODE SUPPORT >> WinNT
With ttipW
' --if we want it centered, then set that flag
If m_lttCentered Then
.lFlags = TTF_SUBCLASS Or TTF_CENTERTIP Or TTF_IDISHWND
Else
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
End If
' --set the hwnd prop to our parent control's hwnd
.lHwnd = UserControl.hWnd
.lId = hWnd
.lSize = Len(ttipW)
.hInstance = App.hInstance
.lpStrW = StrPtr(m_sTooltipText)
.lpRect = lpRect
End With
' --add the tooltip structure
SendMessage m_lttHwnd, TTM_ADDTOOLW, 0&, ttipW
Else
' --set our tooltip info structure for << WinNT
With ttip
''if we want it centered, then set that flag
If m_lttCentered Then
.lFlags = TTF_SUBCLASS Or TTF_CENTERTIP
Else
.lFlags = TTF_SUBCLASS
End If
' --set the hwnd prop to our parent control's hwnd
.lHwnd = UserControl.hWnd
.lId = hWnd
.lSize = Len(ttip)
.hInstance = App.hInstance
.lpStr = m_sTooltipText
.lpRect = lpRect
End With
' --add the tooltip structure
SendMessage m_lttHwnd, TTM_ADDTOOLA, 0&, ttip
End If
'if we want a title or we want an icon
If m_sTooltiptitle <> vbNullString Or m_lToolTipIcon <> TTNoIcon Then
If m_WindowsNT Then
lPtr = StrPtr(m_sTooltiptitle)
If lPtr Then
SendMessage m_lttHwnd, TTM_SETTITLEW, m_lToolTipIcon, ByVal lPtr
End If
Else
SendMessage m_lttHwnd, TTM_SETTITLE, CLng(m_lToolTipIcon), ByVal m_sTooltiptitle
End If
End If
SendMessage m_lttHwnd, TTM_SETMAXTIPWIDTH, 0, 240 'for Multiline capability
If m_lttBackColor <> Empty Then
SendMessage m_lttHwnd, TTM_SETTIPBKCOLOR, TranslateColor(m_lttBackColor), 0&
End If
End Sub