home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
design
/
mstips
/
tipdemo.bas
< prev
next >
Wrap
BASIC Source File
|
1995-02-27
|
7KB
|
221 lines
Option Explicit
'If you have questions, comments, or suggestions for
'improving the code presented here, please forward them
'to me; your input is welcome:
'
' Brad Kaenel
' PC HELP-LINE
' 35250 Silver Leaf Circle
' Yucaipa, CA 92399
' United States
' CIS: 72357,3523
' Internet: 72357.3523@compuserve.com
'
'Microsoft started the "tooltip" fad (the little yellow
'windows that popup when your mouse lingers over a
'toolbar button), so now everybody has to have them.
'There are several 3rd-party VBXs that do tooltips,
'but this is a pure VB example.
'To give credit where credit is due, the idea for this
'code originally came from an example I found in the
'Microsoft Knowledge Base. The code was simple, and
'it worked fine, but it wasn't very reusable because it
'contained a lot of hard-coded form and control names.
'Since I wanted something that I could drop into any
'project with minimal work, I re-architected the MSKB
'example and turned it into a reusable component.
'There is one limitation you should note. This code
'uses the hWnd property to identify specific controls
'on your forms. If your toolbars (or whatever it is
'that you're displaying tooltips on) are constructed
'with "light-weight" controls, or 3rd-party controls
'that do not provide a hWnd property, life is going to
'be rather unpleasant.
'If the light-weight controls are children of a
'container control (a picturebox or panel, for example)
'that *does* have a hWnd property, you can do some
'X/Y coordinate calculations in your callback
'function (see Step 5, below) to determine exactly
'what tip text to display.
'To add tooltips to your application, follow these steps:
'
' 1. Add DUTIP.FRM and DUTIP.BAS to your project.
'
' 2. Insert a "Call dutip_EnableTips" statement
' somewhere in your initialization code.
'
' 3. Insert a "Call dutip_DisableTips" statement
' somewhere in your termination code.
'
' 4. Insert a "Call dutip_SetTipForm(Me)" statement
' in the Form_Activate event of each form that
' needs tooltips.
'
' 5. This is the only tricky part. The generic
' modules (DUTIP.FRM and DUTIP.BAS) do all the
' work of monitoring the mouse and displaying
' the tip window. There's only one thing they
' can't do, because it's different for each app --
' they can't provide the text that's displayed
' in the tooltip popups.
'
' Your app supplies the text via a customized
' Function procedure that *you* have to write,
' and its name must be "ToolTips_sGetTipText".
' If you're familiar with Windows "callback"
' functions, this works kind of the same way.
'
' ToolTips_sGetTipText passes you the Control
' that the mouse is hovering over, and you have
' to pass back the corresponding tip text for
' that Control.
'
' The method you use for figuring out what text
' goes with what Control is totally up to you.
' In this demo, I use the HelpContextID property
' because that's usually a unique identifier for
' each Control. But you could choose to use the
' Tag property, or any other convenient or clever
' method.
'
' IMPORTANT: Be careful when using property values
' to identify Controls, especially if
' you use 3rd-party VBXs. You could
' generate a runtime-error if your code
' refers to a property name that doesn't
' exist on certain Controls. Use error
' trapping to protect yourself.
'
' Anyway, the only code *you* have to write is a
' custom "ToolTips_sGetTipText" callback function
' for each application that uses tooltips; everything
' else is handled for you.
Type RECTAPI
X1 As Integer
Y1 As Integer
X2 As Integer
Y2 As Integer
End Type
Declare Function PtInRect Lib "User" (lpRect As RECTAPI, ByVal Pnt As Long) As Integer
Sub EndMain ()
Unload Form1
Unload Form2
Call dutip_DisableTips 'Unloads the Tip form
End
End Sub
Sub Main ()
Call dutip_EnableTips 'Loads the Tip form
Form2.Show
Form1.Show
End Sub
Function ToolTips_sGetTipText (ctlControl As Control, nMouseX_Pixels As Integer, nMouseY_Pixels As Integer)
'This is a sample "callback" function that provides
'the text for the tooltips. When you write one for
'your own app, make sure the Function declaration
'stays the same (both the name and the parameter list).
Dim nlTipID As Long
Dim sTipText As String
Dim flBorderWidth As Single, flTitleBarHeight As Single
Dim nlPoint As Long
Dim recRect As RECTAPI
'Error trapping is mandatory
'because some Controls might
'not have a HelpContextID
On Error Resume Next 'property, for example.
nlTipID = ctlControl.HelpContextID
'This statement will generate
'a runtime error on Controls that
'don't have a HelpContextID
'property.
If Err <> 0 Then
sTipText = ""
Exit Function
End If
On Error GoTo 0
Select Case nlTipID 'Identify the specific Control
Case 1001
sTipText = "Text Box"
Case 1002
sTipText = "List Box"
Case 1003
sTipText = "Command Button: this is pretty cool."
Case 1004
sTipText = "Check Box: this is even cooler and more awesome, surfer dudes!"
Case 2001
sTipText = "Command Button #1"
Case 2002
sTipText = "Command Button #2"
Case 2003
sTipText = "Combo Box"
Case 2004
sTipText = "Option Button"
Case 2005 'This Picturebox is the toolbar container control
'calculate the coordinates of the Label control
flBorderWidth = (Form2.Width - Form2.ScaleWidth) / 2
flTitleBarHeight = Form2.Height - Form2.ScaleHeight - (flBorderWidth * 2)
recRect.X1 = (Form2.Left + flBorderWidth + ctlControl.Left + Form2.Label1.Left) / Screen.TwipsPerPixelX
recRect.Y1 = (Form2.Top + flBorderWidth + flTitleBarHeight + ctlControl.Top + Form2.Label1.Top) / Screen.TwipsPerPixelY
recRect.X2 = recRect.X1 + (Form2.Label1.Width / Screen.TwipsPerPixelX)
recRect.Y2 = recRect.Y1 + (Form2.Label1.Height / Screen.TwipsPerPixelY)
nlPoint = nMouseX_Pixels + CLng(nMouseY_Pixels) * &H10000
'Is the mouse over the Label control ?
If PtInRect(recRect, nlPoint) <> 0 Then
sTipText = "Label Control (in a Picture Box)"
Else
sTipText = "" 'no; it's over the toolbar background
End If
Case Else
sTipText = ""
End Select
ToolTips_sGetTipText = sTipText
'Pass the tip text back to the
'generic modules
End Function