home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / myttips / ttips.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-20  |  2.6 KB  |  100 lines
  1. Const TIPS_SW_SHOWNOACTIVATE = 4
  2. Const TIPS_XGW_CHILD = 5         ' Needed for edit portion of combo box
  3.  
  4. Type TIPS_POINTAPI  '4 Bytes - Synonymous with LONG
  5.         x As Integer
  6.         y As Integer
  7. End Type
  8.  
  9. Type tooltip_type
  10.     hWnd As Long
  11.     Tip As String
  12.     Help As String
  13. End Type
  14.  
  15. Declare Sub GetCursorPos Lib "User" (lpPoint As TIPS_POINTAPI)
  16. Declare Function GetActiveWindow Lib "User" () As Integer
  17. Declare Function WindowFromPoint Lib "user" (ByVal lpPointY As Integer, ByVal lpPointX As Integer) As Integer
  18. Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
  19. Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer
  20.  
  21.  
  22.  
  23.  
  24. Global gtooltip() As tooltip_type
  25.  
  26. Sub AddTip (ByVal hWnd As Long, ByVal Tip As String, ByVal Help As String)
  27. x = UBound(gtooltip) + 1
  28.  
  29. ReDim Preserve gtooltip(x) As tooltip_type
  30. gtooltip(x).hWnd = hWnd
  31. gtooltip(x).Tip = Tip
  32. gtooltip(x).Help = Help
  33. End Sub
  34.  
  35. Sub DisplayTips ()
  36. Static LastHwnd As Long
  37. Dim p As TIPS_POINTAPI
  38.  
  39. GetCursorPos p
  40. CurHwnd = WindowFromPoint(p.y, p.x)
  41.  
  42. If LastHwnd = CurHwnd Then Exit Sub
  43.  
  44. LastHwnd = CurHwnd
  45.  
  46. For a = LBound(gtooltip) To UBound(gtooltip)
  47.     If CurHwnd = gtooltip(a).hWnd And gtooltip(a).Tip <> "" Then
  48.         TTips.Tip = gtooltip(a).Tip
  49.         Theight = TTips.Tip.Height
  50.         TWidth = TTips.Tip.Width
  51.         TTips.Tip.AutoSize = False
  52.         TTips.Tip.Width = TWidth + 15
  53.         TTips.Tip.Height = Theight + 16
  54.         TTips.Top = (p.y + 18) * Screen.TwipsPerPixelY
  55.         TTips.Left = (p.x - 2) * Screen.TwipsPerPixelY
  56.         TTips.Height = TTips.Tip.Height
  57.         TTips.Width = TTips.Tip.Width
  58.         'With .Help member you can fill a statusbar
  59.         Form1.StatBar = gtooltip(a).Help
  60.         '----------------------------------------
  61.         TTips.ZOrder
  62.         ' Show form without the focus:
  63.         ret = ShowWindow(TTips.hWnd, TIPS_SW_SHOWNOACTIVATE)
  64.  
  65.         Exit Sub
  66.     End If
  67.     
  68.     TTips.Hide
  69.     ' Help on StatBar
  70.     Form1.StatBar = ""
  71.     TTips.Tip.AutoSize = True
  72. Next a
  73.  
  74.  
  75.  
  76. End Sub
  77.  
  78. Sub InitializeTips ()
  79. ReDim gtooltip(0) As tooltip_type
  80. End Sub
  81.  
  82. Sub removeTip (ByVal hWnd As Long)
  83. Dim a, b, u As Integer
  84.  
  85. up = UBound(gtooltip)
  86.  
  87. For a = LBound(gtooltip) To up
  88.     If gtooltip(a).hWnd = hWnd Then
  89.         For b = a + 1 To up
  90.             gtooltip(b - 1).hWnd = gtooltip(b).hWnd
  91.             gtooltip(b - 1).Tip = gtooltip(b).Tip
  92.             gtooltip(b - 1).Help = gtooltip(b).Help
  93.         Next b
  94.         ReDim Preserve gtooltip(up - 1) As tooltip_type
  95.         Exit For
  96.      End If
  97. Next a
  98. End Sub
  99.  
  100.