home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / design / mstips / tipdemo.bas < prev    next >
Encoding:
BASIC Source File  |  1995-02-27  |  6.8 KB  |  221 lines
  1. Option Explicit
  2.  
  3. 'If you have questions, comments, or suggestions for
  4. 'improving the code presented here, please forward them
  5. 'to me; your input is welcome:
  6. '
  7. '        Brad Kaenel
  8. '        PC HELP-LINE
  9. '        35250 Silver Leaf Circle
  10. '        Yucaipa, CA  92399
  11. '        United States
  12. '        CIS: 72357,3523
  13. '        Internet: 72357.3523@compuserve.com
  14. '
  15.  
  16. 'Microsoft started the "tooltip" fad (the little yellow
  17. 'windows that popup when your mouse lingers over a
  18. 'toolbar button), so now everybody has to have them.
  19. 'There are several 3rd-party VBXs that do tooltips,
  20. 'but this is a pure VB example.
  21.  
  22. 'To give credit where credit is due, the idea for this
  23. 'code originally came from an example I found in the
  24. 'Microsoft Knowledge Base.  The code was simple, and
  25. 'it worked fine, but it wasn't very reusable because it
  26. 'contained a lot of hard-coded form and control names.
  27.  
  28. 'Since I wanted something that I could drop into any
  29. 'project with minimal work, I re-architected the MSKB
  30. 'example and turned it into a reusable component.
  31.  
  32. 'There is one limitation you should note.  This code
  33. 'uses the hWnd property to identify specific controls
  34. 'on your forms.  If your toolbars (or whatever it is
  35. 'that you're displaying tooltips on) are constructed
  36. 'with "light-weight" controls, or 3rd-party controls
  37. 'that do not provide a hWnd property, life is going to
  38. 'be rather unpleasant.
  39.  
  40. 'If the light-weight controls are children of a
  41. 'container control (a picturebox or panel, for example)
  42. 'that *does* have a hWnd property, you can do some
  43. 'X/Y coordinate calculations in your callback
  44. 'function (see Step 5, below) to determine exactly
  45. 'what tip text to display.
  46.  
  47. 'To add tooltips to your application, follow these steps:
  48. '
  49. '  1. Add DUTIP.FRM and DUTIP.BAS to your project.
  50. '
  51. '  2. Insert a "Call dutip_EnableTips" statement
  52. '     somewhere in your initialization code.
  53. '
  54. '  3. Insert a "Call dutip_DisableTips" statement
  55. '     somewhere in your termination code.
  56. '
  57. '  4. Insert a "Call dutip_SetTipForm(Me)" statement
  58. '     in the Form_Activate event of each form that
  59. '     needs tooltips.
  60. '
  61. '  5. This is the only tricky part.  The generic
  62. '     modules (DUTIP.FRM and DUTIP.BAS) do all the
  63. '     work of monitoring the mouse and displaying
  64. '     the tip window.  There's only one thing they
  65. '     can't do, because it's different for each app --
  66. '     they can't provide the text that's displayed
  67. '     in the tooltip popups.
  68. '
  69. '     Your app supplies the text via a customized
  70. '     Function procedure that *you* have to write,
  71. '     and its name must be "ToolTips_sGetTipText".
  72. '     If you're familiar with Windows "callback"
  73. '     functions, this works kind of the same way.
  74. '
  75. '     ToolTips_sGetTipText passes you the Control
  76. '     that the mouse is hovering over, and you have
  77. '     to pass back the corresponding tip text for
  78. '     that Control.
  79. '
  80. '     The method you use for figuring out what text
  81. '     goes with what Control is totally up to you.
  82. '     In this demo, I use the HelpContextID property
  83. '     because that's usually a unique identifier for
  84. '     each Control.  But you could choose to use the
  85. '     Tag property, or any other convenient or clever
  86. '     method.
  87. '
  88. '     IMPORTANT: Be careful when using property values
  89. '                to identify Controls, especially if
  90. '                you use 3rd-party VBXs.  You could
  91. '                generate a runtime-error if your code
  92. '                refers to a property name that doesn't
  93. '                exist on certain Controls.  Use error
  94. '                trapping to protect yourself.
  95. '
  96. '     Anyway, the only code *you* have to write is a
  97. '     custom "ToolTips_sGetTipText" callback function
  98. '     for each application that uses tooltips; everything
  99. '     else is handled for you.
  100.  
  101. Type RECTAPI
  102.    X1 As Integer
  103.    Y1 As Integer
  104.    X2 As Integer
  105.    Y2 As Integer
  106. End Type
  107.  
  108. Declare Function PtInRect Lib "User" (lpRect As RECTAPI, ByVal Pnt As Long) As Integer
  109.  
  110. Sub EndMain ()
  111.  
  112. Unload Form1
  113. Unload Form2
  114.  
  115. Call dutip_DisableTips  'Unloads the Tip form
  116.  
  117. End
  118.  
  119. End Sub
  120.  
  121. Sub Main ()
  122.  
  123. Call dutip_EnableTips  'Loads the Tip form
  124.  
  125. Form2.Show
  126. Form1.Show
  127.  
  128. End Sub
  129.  
  130. Function ToolTips_sGetTipText (ctlControl As Control, nMouseX_Pixels As Integer, nMouseY_Pixels As Integer)
  131.  
  132. 'This is a sample "callback" function that provides
  133. 'the text for the tooltips.  When you write one for
  134. 'your own app, make sure the Function declaration
  135. 'stays the same (both the name and the parameter list).
  136.  
  137.  
  138. Dim nlTipID As Long
  139. Dim sTipText As String
  140.  
  141. Dim flBorderWidth As Single, flTitleBarHeight As Single
  142. Dim nlPoint As Long
  143. Dim recRect As RECTAPI
  144.  
  145.  
  146.                       'Error trapping is mandatory
  147.                       'because some Controls might
  148.                       'not have a HelpContextID
  149. On Error Resume Next  'property, for example.
  150.  
  151. nlTipID = ctlControl.HelpContextID
  152.                       'This statement will generate
  153.                       'a runtime error on Controls that
  154.                       'don't have a HelpContextID
  155.                       'property.
  156. If Err <> 0 Then
  157.    sTipText = ""
  158.    Exit Function
  159. End If
  160.  
  161. On Error GoTo 0
  162.  
  163.  
  164. Select Case nlTipID   'Identify the specific Control
  165.    Case 1001
  166.       sTipText = "Text Box"
  167.  
  168.    Case 1002
  169.       sTipText = "List Box"
  170.  
  171.    Case 1003
  172.       sTipText = "Command Button: this is pretty cool."
  173.  
  174.    Case 1004
  175.       sTipText = "Check Box: this is even cooler and more awesome, surfer dudes!"
  176.  
  177.    Case 2001
  178.       sTipText = "Command Button #1"
  179.  
  180.    Case 2002
  181.       sTipText = "Command Button #2"
  182.  
  183.    Case 2003
  184.       sTipText = "Combo Box"
  185.  
  186.    Case 2004
  187.       sTipText = "Option Button"
  188.  
  189.    Case 2005  'This Picturebox is the toolbar container control
  190.       
  191.       'calculate the coordinates of the Label control
  192.       
  193.       flBorderWidth = (Form2.Width - Form2.ScaleWidth) / 2
  194.       flTitleBarHeight = Form2.Height - Form2.ScaleHeight - (flBorderWidth * 2)
  195.  
  196.       recRect.X1 = (Form2.Left + flBorderWidth + ctlControl.Left + Form2.Label1.Left) / Screen.TwipsPerPixelX
  197.       recRect.Y1 = (Form2.Top + flBorderWidth + flTitleBarHeight + ctlControl.Top + Form2.Label1.Top) / Screen.TwipsPerPixelY
  198.       recRect.X2 = recRect.X1 + (Form2.Label1.Width / Screen.TwipsPerPixelX)
  199.       recRect.Y2 = recRect.Y1 + (Form2.Label1.Height / Screen.TwipsPerPixelY)
  200.  
  201.       nlPoint = nMouseX_Pixels + CLng(nMouseY_Pixels) * &H10000
  202.  
  203.       'Is the mouse over the Label control ?
  204.  
  205.       If PtInRect(recRect, nlPoint) <> 0 Then
  206.          sTipText = "Label Control (in a Picture Box)"
  207.       Else
  208.          sTipText = ""  'no; it's over the toolbar background
  209.       End If
  210.  
  211.    Case Else
  212.       sTipText = ""
  213.  
  214. End Select
  215.       
  216. ToolTips_sGetTipText = sTipText
  217.                       'Pass the tip text back to the
  218.                       'generic modules
  219. End Function
  220.  
  221.