HughLerwill
Programmer
Further to thread222-1518176 all is well with multi-monitors for me now except that conventional ToolTipText does not display in the intended position for Labels and Images when they are on a secondary monitor. So now I'm looking at implementing API based ToolTips (again!); that has been going quite well however I'm stumpted when applying an API Tooltip to a ComboBox; the ToolTip produced by the following (implemented in an ActiveX dll) only appears when the mouse hovers over the Dropdown Arrow box or over a very narrow band around its main text area. How can I get the ToolTip to appear when the mouse hovers over the main TextBox area of the Combo?
The following sets up a Balloon style API ToolTip for a Control (Cntrl) where sMessage is the required text
The following sets up a Balloon style API ToolTip for a Control (Cntrl) where sMessage is the required text
Code:
Public Sub Assign(Cntrl As Object, ByVal sMessage$)
Dim TipWindow&, sm&, sh&, sw&, sl&, st&, hWndCreatedInside&
Dim TI As TOOLINFO
Dim lRECT As RECT
On Error Resume Next
If Cntrl.hWnd Then
If Err = 0 Then 'the Control has an hwnd so treatment is conventional
On Error GoTo 0
TipWindow = CreateWindowEx(0&, TOOLTIPS_CLASSA, "", TTS_ALWAYSTIP Or TTS_BALLOON, 0, 0, 0, 0, Cntrl.hWnd, 0&, App.hInstance, 0&)
SetWindowPos TipWindow, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
GetClientRect Cntrl.hWnd, lRECT
hWndCreatedInside = Cntrl.hWnd
Else 'the Control is typically a Label or an Image
On Error GoTo 0
TipWindow = CreateWindowEx(0&, TOOLTIPS_CLASSA, "", TTS_ALWAYSTIP Or TTS_BALLOON, 0, 0, 0, 0, Cntrl.Container.hWnd, 0&, App.hInstance, 0&)
SetWindowPos TipWindow, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
If TypeOf Cntrl.Container Is Frame Then
'Frame has no ScaleMode property and is always scaled in Twips
With lRECT
.Left = Cntrl.Left \ Screen.TwipsPerPixelX
.Top = Cntrl.Top \ Screen.TwipsPerPixelY
.Right = (Cntrl.Left \ Screen.TwipsPerPixelX + Cntrl.Width \ Screen.TwipsPerPixelX)
.Bottom = (Cntrl.Top \ Screen.TwipsPerPixelY + Cntrl.Height \ Screen.TwipsPerPixelY)
End With
Else 'container is typically a Form or a Picture
With Cntrl.Container
'save ScaleMode
sm = .ScaleMode
If sm = vbUser Then
sh = .ScaleHeight
sw = .ScaleWidth
sl = .ScaleLeft
st = .ScaleTop
End If
.ScaleMode = vbPixels 'because API call requires pixels
With lRECT
.Left = Cntrl.Left
.Top = Cntrl.Top
.Right = (Cntrl.Left + Cntrl.Width)
.Bottom = (Cntrl.Top + Cntrl.Height)
End With
'restore ScaleMode
If sm = vbUser Then
.ScaleHeight = sh
.ScaleWidth = sw
.ScaleLeft = sl
.ScaleTop = st
Else
Cntrl.Container.ScaleMode = sm
End If
End With
End If
hWndCreatedInside = Cntrl.Container.hWnd
End If
With TI 'Fill the TOOLINFO structure with info about the target tool
.cbSize = Len(TI)
.uFlags = TTF_SUBCLASS 'Or TTF_CENTERTIP 'not using TTF_IDISHWND
.hWnd = hWndCreatedInside
.hinst = App.hInstance
.RECT = lRECT
.lpszText = sMessage
End With
SendMessage TipWindow, TTM_ADDTOOLA, 0, TI
SendMessage TipWindow, TTM_SETMAXTIPWIDTH, 0, ByVal 100 'default width 100 pixels; the TTM_SETMAXTIPWIDTH call enables a multiline Tooltip
'Colors do not get set if XP/ Vista Style are in use
' so when styles are not in use settle for the existing defaults typically black on yellow
'SendMessage TipWindow, TTM_SETTIPBKCOLOR, mBackColor, 0
'SendMessage TipWindow, TTM_SETTIPTEXTCOLOR, mForeColor, 0
SendMessage TipWindow, TTM_SETDELAYTIME, TTDT_INITIAL, ByVal 50 'displays after n milliseconds
SendMessage TipWindow, TTM_SETDELAYTIME, TTDT_AUTOPOP, ByVal 10000 'displays for n milliseconds
'return handle to the tip window in the control's Cntrl.WhatsThisHelpID so we can do
' further SendMessage calls to it eg. SendMessage Cntrl.WhatsThisHelpID, TTM_SETTITLE, mIconType, ByVal mTitle$
Cntrl.WhatsThisHelpID = TipWindow
End If
End Sub