 |
|
 |
fabulous
Level: VB Guru
Registered: 03-08-2002
Posts: 439
|
Re: Custom Tooltips Query
Good news, there is a way to change you tooltip provided you make the modification to the ToolTip.bas module that I have supplied. Those who don't know what we are talking about can download the code at http://www.andreavb.com/tip050007.html). to see what we are talking about. If you unzip the file you will find a module called ToolTip.Bas which allows you to add custom mulitiline balloon tip text to any contrl with the hWnd property, this is what we are going to change. The limitations it has are that there is no way to change the the tip or to remove it.
The changes you will need to make start with the TOldWndProc structure in the module and add a module level boolean variable as such:
Private Type TOldWndProc
hWnd As Long
hControl As Long
ptrForm As Long
Info As TOOLINFO
lPrevWndProc As Long
End Type
Private TipIsChanging As Boolean |
next we will change the AddCustomToolTip procedure to this, just paste this code it works:
' Add the Custom ToolTip to the specified object
Public Sub AddCustomToolTip(x As Object, ToolTipText As String, FormOwner As Form)
Dim ti As TOOLINFO
Dim dwStyle As Long
Dim hTip As Long
' A tooltip control with the TTS_ALWAYSTIP style appears when the cursor is
' on a tool, regardless of whether the tooltip control's owner window is active
' or inactive. Without this style, the tooltip control appears when the tool's
' owner window is active, but not when it is inactive.
hTip = CreateWindowEx(0&, "tooltips_class32", "", TTS_ALWAYSTIP, _
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
FormOwner.hWnd, 0&, App.hInstance, 0&)
With ti
.cbSize = Len(ti)
.uFlags = TTF_IDISHWND + TTF_SUBCLASS
.hWnd = x.hWnd
.uId = x.hWnd
.lpszText = ToolTipText
End With
SendMessage hTip, TTM_ADDTOOL, 0&, ti
' SubClass the tooltip window
If TipIsChanging Then
TipIsChanging = False
Else
ReDim Preserve WndProc(NumTips)
End If
With WndProc(NumTips)
.hWnd = hTip
.hControl = x.hWnd
.ptrForm = ObjPtr(FormOwner) 'don't keep a live reference of the form
.Info = ti
.lPrevWndProc = SetWindowLong(hTip, GWL_WNDPROC, AddressOf CustomTipProc)
End With
NumTips = NumTips + 1
' Remove Border from ToolTip
dwStyle = GetWindowLong(hTip, GWL_STYLE)
dwStyle = dwStyle And (Not WS_BORDER)
SetWindowLong hTip, GWL_STYLE, dwStyle
End Sub |
After the change, the sub now saves the handle of the object that owns the tip, the TOOLINFO structure that contains info about it and a pointer to the owner form along with the stuff kept in it previously. To allow you to change and delete items, paste the following code into the module as well.
Public Sub ChangeToolTip(obj As Object, newtip As String)
Dim lng As Long, Info As TOOLINFO, hWnd As Long
Dim lPrevWndProc As Long, found As Boolean, ptrForm As Long
'find out if the object is in the array
For lng = LBound(WndProc) To UBound(WndProc)
With WndProc(lng)
If .hControl = obj.hWnd Then 'we have found our item
lPrevWndProc = .lPrevWndProc
Info = .Info
ptrForm = .ptrForm
hWnd = .hWnd
found = True
Exit For
End If
End With
Next
'do this only if something was found. Ignore otherwise
'could have chosen to raise an error but anyone changing a tip they
'haven't provided deserves to be ignored.
If found Then
DeleteArrayItem WndProc, lng, NumTips
SetWindowLong hWnd, GWL_WNDPROC, lPrevWndProc
SendMessage hWnd, TTM_DELTOOL, 0&, Info
'now that it has been removed, create another one
'tell AddCustomToolTip that it is us changing the tip
TipIsChanging = True
AddCustomToolTip obj, newtip, GetForm(ptrForm)
End If
End Sub
Private Sub DeleteArrayItem(arr() As TOldWndProc, ByVal Index As Long, ByRef NumElements As Long)
'make sure that a valid item is being deleted
Debug.Assert Index <= UBound(arr) And Index >= LBound(arr)
Dim lng As Long
For lng = Index To UBound(arr) - 1
arr(lng) = arr(lng + 1)
Next
'now change the number of elements
NumElements = NumElements - 1
' ReDim Preserve arr(NumElements) As TOldWndProc 'resize the array
End Sub
'return a form reference from a pointer
Private Function GetForm(ByVal Pointer As Long) As Form
Dim xForm As Form
CopyMemory xForm, Pointer, 4
Set GetForm = xForm
CopyMemory xForm, 0&, 4
End Function
Public Sub RemoveTip(obj As Object)
Dim lng As Long, found As Boolean
For lng = LBound(WndProc) To UBound(WndProc)
With WndProc(lng)
If .hControl = obj.hWnd Then
SetWindowLong .hWnd, GWL_WNDPROC, .lPrevWndProc
SendMessage .hWnd, TTM_DELTOOL, 0&, .Info
found = True
Exit For
End If
End With
Next
If found Then DeleteArrayItem WndProc, lng, NumTips
End Sub |
That is the code that does the work, now for the user interface bit. Have a form with 3 command buttons, Command1, Command2 and Command3. Paste the following code to the form.
Private Sub Form_Load()
Dim msg as string, msg2 as string, msg3 as string
msg = "This is an example of a" & vbCrlf
msg = msg & "Custom tooltip window with" & vbcrlf
msg = msg & "multiline text. This tip will" & vbcrlf
msg = msg & "change if you clidk this button"
msg2 = "This tooltip text will" & vbcrlf
msg2 = msg2 & "disppear when you click this button."
msg3 = "This tip just tells you that Fadz is fabulous." & vbcrlf
msg3 = "Click here to close the app"
AddCustomToolTip Command1, msg, me
AddCustomToolTip Command2, msg2, Me
AddCustomToolTip Command3, msg3, Me
End Sub
Private Sub Command1_Click()
static msg as string
if msg = "" Then
msg = "As you can see this tooltip" & vbcrlf
msg = msg & "has changed."
end if
ChangeToolTip Command1, msg
End sub
Private Sub Command2_Click()
'delete tooltip
RemoveTip Command2
End Sub
Private Sub Command3_Click()
Unload Me
end sub |
I have just rushed through this code and I'm sure the same thing could be achieved with less code. My primary concern was to see it work. Also, you may notice code duplication in ChangeToolTip and RemoveTip. I had forgotten to implement RemoveTip until the last minute & didn't wnat to review any of my code. Anyway, it works and that's all that matters, happy coding!
____________________________
My boss is a Jewish Carpenter (Jesus Christ)
Brain Bench Certified VB.NET Developer
|
|
09-05-2003 at 12:20 PM |
|
|
|
|
 |
|
Custom Tooltips Query
Re: Custom Tooltips Query
