Article ID: 119991
Article Last Modified on 11/6/2000
RecordSource: <blank>
ScrollBars: Neither
RecordSelectors: No
NavigationButtons: No
PopUp: Yes
BorderStyle: None
Width: 4 in
OnTimer: [Event Procedure]
OnTimer Event Procedure
-----------------------
Sub Form_Timer ()
ShowToolTips Me
End Sub
Name: TipText
Left: 0
Top: 0
Width: 4 in
Height: 0.166 in
BackColor: 8454143
BorderStyle: Clear
FontName: MS Sans Serif
FontSize: 8
TextAlign: Center
OnMouseMove: [Event Procedure]
OnMouseMove Event Procedure
-------------------------------------------------------------
Sub TipText_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
HideToolTips
End Sub
0.166 in
Option Explicit
' Tip Delay (time to wait to display tip) constants (in
' milliseconds).
Const TipDelayIfHidden = 1000
Const TipDelayIfVisible = 100
' Tip size and placement adjustment constants.
Const AdjustTipWidth = .75
Const AdjustTipWidthPixel = 5
Const AdjustTipLeft = .3
Const AdjustTipTop = .6
' Windows API constants and Declarations.
Type POINTAPI
X As Integer
Y As Integer
End Type
Type RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Global Const SM_CXCURSOR = 13
Global Const SM_CYCURSOR = 14
Global Const SW_SHOWNOACTIVATE = 4
Global Const TwipsPerPixel = 15
Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As RECT)
Declare Sub MoveWindow Lib "User" (ByVal hWnd%, ByVal X%, _
ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal bRepaint%)
Declare Function GetDC Lib "User" (ByVal hWnd%) As Integer
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex%) _
As Integer
Declare Function GetTextExtent Lib "GDI" (ByVal hDC%, _
ByVal lpString As String, ByVal nCount%) As Long
Declare Function ReleaseDC Lib "User" (ByVal hWnd%, ByVal hDC%) _
As Integer
Declare Function ShowWindow Lib "User" (ByVal hWnd%, _
ByVal CmdShow%) As Integer
' ToolTips variables to store tip information.
Global TipPoint As POINTAPI
Global TipText As String
Global TipTextLast As String
Sub ToolTips (MyTipText)
' **********************************************************
' PURPOSE: Sets up ToolTips for view after a delay of
' TipDelayIfHidden or TipDelayIfVisible milliseconds
' using the ToolTips form's Timer event.
' USAGE: Call this procedure from the MouseMove event of any
' control for which you want to display ToolTips.
' PARAMETERS:
' MyTipText: The ToolTips caption text.
' **********************************************************
Dim Tip As Form
' Get tip form and open if not yet opened.
On Error Resume Next
Set Tip = Forms!ToolTips
If Err Then StartToolTips
' If the tip is already visible with the desired
' text, then exit.
If Tip.Visible And TipText = MyTipText Then Exit Sub
' Record new tip information.
TipTextLast = TipText ' Save last tip.
TipText = MyTipText ' Save new tip text.
GetCursorPos TipPoint ' Get and save the current mouse
' pointer position.
' Set new tip delay (time to wait before displaying the tip).
' If the tip is NOT visible...
If Not Tip.Visible Then
' ...then set the standard delay to display the tip
' from a hidden state.
Tip.TimerInterval = TipDelayIfHidden
Else
' ...otherwise the pointer is moving from tip to tip, so
' set a shorter delay. Set a shorter delay only if the
' shorter delay has not yet been set.
If Tip.TimerInterval <> TipDelayIfVisible Then
Tip.TimerInterval = TipDelayIfVisible
End If
End If
End Sub
Sub HideToolTips ()
' **********************************************************
' PURPOSE: Hides ToolTips from view.
' USAGE: Call from the MouseMove event of all form sections
' that contain ToolTips-enabled controls.
' OPTIONAL (but recommended): Call from the MouseMove event
' of all form sections on all forms and from MouseMove
' events of controls that are not ToolTips-enabled.
' CALLED FROM: MouseMove event of the TipText text box, the
' ShowToolTips procedure, the MouseMove event of form
' sections, and non-ToolTips-enabled controls.
' **********************************************************
Dim F As Form
' Get tip form and open if not yet opened
On Error Resume Next
Set F = Forms!ToolTips
If Err Then StartToolTips
' Hide tip and turn delay off
F.Visible = False
F.TimerInterval = 0
End Sub
Sub ShowToolTips (Tip As Form)
' **********************************************************
' PURPOSE: Displays ToolTips caption.
' CALLED FROM: ToolTips form Timer event only.
' **********************************************************
Dim P As POINTAPI
Dim R As RECT
Dim hDC As Integer
Dim RetVal As Integer
Dim TipLeft As Integer, TipTop As Integer
Dim TipWidth As Integer, TipHeight As Integer
' Get the current mouse pointer position.
GetCursorPos P
' If displaying the tip from a hidden state was delayed...
If Tip.TimerInterval = TipDelayIfHidden Then
' ...and the mouse pointer position does not match the
' pre-delay position...
If Not (P.X = TipPoint.X And P.Y = TipPoint.Y) Then
' ...then hide the tip and exit.
HideToolTips
Exit Sub
End If
End If
' Turn the tip delay off.
Tip.TimerInterval = 0
' Compute approximate TipWidth.
hDC = GetDC(0)
TipWidth = GetTextExtent(hDC, TipText, Len(TipText)) And &HFFFF&
RetVal = ReleaseDC(0, hDC)
TipWidth = (TipWidth * AdjustTipWidth) + AdjustTipWidthPixel
' Compute TipHeight.
GetWindowRect Tip.hWnd, R
TipHeight = R.Bottom - R.Top
' Compute TipLeft.
TipLeft = P.X + (GetSystemMetrics(SM_CXCURSOR) * AdjustTipLeft)
TipLeft = TipLeft - (TipWidth / 2)
' Compute TipTop.
TipTop = P.Y + (GetSystemMetrics(SM_CYCURSOR) * AdjustTipTop)
' Hide tip form.
Tip.Visible = False
' Set tip text.
Tip!TipText = TipText
' Set tip text box width.
Tip!TipText.Width = TipWidth * TwipsPerPixel
' Move and size tip form.
MoveWindow Tip.hWnd, TipLeft, TipTop, TipWidth, TipHeight, False
' Show tip form.
RetVal = ShowWindow(Tip.hWnd, SW_SHOWNOACTIVATE)
End Sub
Private Sub StartToolTips ()
' **********************************************************
' PURPOSE: Opens the ToolTips form.
' CALLED FROM: HideToolTips, ShowToolTips procedures only.
' **********************************************************
DoCmd OpenForm "ToolTips", , , , , A_HIDDEN
End Sub
Sub SaveRecord_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
ToolTips "Save Record"
End Sub
Sub Detail0_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
HideToolTips
End Sub
DoCmd Close A_FORM, "ToolTips"
Keywords: kbhowto kbusage KB119991