home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Virtual_En19489111162005.psc / CToolTip.cls < prev    next >
Text File  |  2005-10-07  |  8KB  |  282 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CTooltip"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. '********************************************************************************************
  19. '* from: http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=46800&lngWId=1 *
  20. '********************************************************************************************
  21.  
  22.  
  23. Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
  24.  
  25. ''Windows API Functions
  26. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  27. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  28. Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  29. Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  30.  
  31. ''Windows API Constants
  32. Private Const WM_USER = &H400
  33. Private Const CW_USEDEFAULT = &H80000000
  34.  
  35. ''Windows API Types
  36. Private Type RECT
  37.         Left As Long
  38.         Top As Long
  39.         Right As Long
  40.         Bottom As Long
  41. End Type
  42.  
  43. ''Tooltip Window Constants
  44. Private Const TTS_NOPREFIX = &H2
  45. Private Const TTF_TRANSPARENT = &H100
  46. Private Const TTF_CENTERTIP = &H2
  47. Private Const TTM_ADDTOOLA = (WM_USER + 4)
  48. Private Const TTM_ACTIVATE = WM_USER + 1
  49. Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
  50. Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
  51. Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
  52. Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
  53. Private Const TTM_SETTITLE = (WM_USER + 32)
  54. Private Const TTS_BALLOON = &H40
  55. Private Const TTS_ALWAYSTIP = &H1
  56. Private Const TTF_SUBCLASS = &H10
  57. Private Const TTF_IDISHWND = &H1
  58. Private Const TTM_SETDELAYTIME = (WM_USER + 3)
  59. Private Const TTDT_AUTOPOP = 2
  60. Private Const TTDT_INITIAL = 3
  61.  
  62. Private Const TOOLTIPS_CLASSA = "tooltips_class32"
  63.  
  64. ''Tooltip Window Types
  65. Private Type TOOLINFO
  66.     lSize As Long
  67.     lFlags As Long
  68.     hWnd As Long
  69.     lId As Long
  70.     lpRect As RECT
  71.     hInstance As Long
  72.     lpStr As String
  73.     lParam As Long
  74. End Type
  75.  
  76.  
  77. Public Enum ttIconType
  78.     TTNoIcon = 0
  79.     TTIconInfo = 1
  80.     TTIconWarning = 2
  81.     TTIconError = 3
  82. End Enum
  83.  
  84. Public Enum ttStyleEnum
  85.     TTStandard
  86.     TTBalloon
  87. End Enum
  88.  
  89. 'local variable(s) to hold property value(s)
  90. Private mvarBackColor As Long
  91. Private mvarTitle As String
  92. Private mvarForeColor As Long
  93. Private mvarIcon As ttIconType
  94. Private mvarCentered As Boolean
  95. Private mvarStyle As ttStyleEnum
  96. Private mvarTipText As String
  97. Private mvarVisibleTime As Long
  98. Private mvarDelayTime As Long
  99.  
  100. 'private data
  101. Private m_lTTHwnd As Long ' hwnd of the tooltip
  102. Private m_lParentHwnd As Long ' hwnd of the window the tooltip attached to
  103. Private ti As TOOLINFO
  104.  
  105. Public Property Let Style(ByVal vData As ttStyleEnum)
  106.    'used when assigning a value to the property, on the left side of an assignment.
  107.    'Syntax: X.Style = 5
  108.    mvarStyle = vData
  109. End Property
  110.  
  111. Public Property Get Style() As ttStyleEnum
  112.    'used when retrieving value of a property, on the right side of an assignment.
  113.    'Syntax: Debug.Print X.Style
  114.    Style = mvarStyle
  115. End Property
  116.  
  117. Public Property Let Centered(ByVal vData As Boolean)
  118.    'used when assigning a value to the property, on the left side of an assignment.
  119.    'Syntax: X.Centered = 5
  120.    mvarCentered = vData
  121. End Property
  122.  
  123. Public Property Get Centered() As Boolean
  124.    'used when retrieving value of a property, on the right side of an assignment.
  125.    'Syntax: Debug.Print X.Centered
  126.    Centered = mvarCentered
  127. End Property
  128.  
  129. Public Function Create(ByVal ParentHwnd As Long) As Boolean
  130.    Dim lWinStyle As Long
  131.    
  132.    If m_lTTHwnd <> 0 Then
  133.       DestroyWindow m_lTTHwnd
  134.    End If
  135.    
  136.    m_lParentHwnd = ParentHwnd
  137.    
  138.    lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
  139.    
  140.    ''create baloon style if desired
  141.    If mvarStyle = TTBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON
  142.     
  143.    m_lTTHwnd = CreateWindowEx(0&, _
  144.       TOOLTIPS_CLASSA, _
  145.       vbNullString, _
  146.       lWinStyle, _
  147.       CW_USEDEFAULT, _
  148.       CW_USEDEFAULT, _
  149.       CW_USEDEFAULT, _
  150.       CW_USEDEFAULT, _
  151.       0&, _
  152.       0&, _
  153.       App.hInstance, _
  154.       0&)
  155.                
  156.    ''now set our tooltip info structure
  157.    With ti
  158.       ''if we want it centered, then set that flag
  159.       If mvarCentered Then
  160.          .lFlags = TTF_SUBCLASS Or TTF_CENTERTIP Or TTF_IDISHWND
  161.       Else
  162.          .lFlags = TTF_SUBCLASS Or TTF_IDISHWND
  163.       End If
  164.        
  165.       ''set the hwnd prop to our parent control's hwnd
  166.       .hWnd = m_lParentHwnd
  167.       .lId = m_lParentHwnd '0
  168.       .hInstance = App.hInstance
  169.       '.lpstr = ALREADY SET
  170.       '.lpRect = lpRect
  171.       .lSize = Len(ti)
  172.    End With
  173.    
  174.    ''add the tooltip structure
  175.    SendMessage m_lTTHwnd, TTM_ADDTOOLA, 0&, ti
  176.  
  177.    ''if we want a title or we want an icon
  178.    If mvarTitle <> vbNullString Or mvarIcon <> TTNoIcon Then
  179.       SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
  180.    End If
  181.  
  182.    If mvarForeColor <> Empty Then
  183.       SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0&
  184.    End If
  185.  
  186.    If mvarBackColor <> Empty Then
  187.       SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0&
  188.    End If
  189.    
  190.    SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime
  191.    SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTime
  192. End Function
  193.  
  194. Public Property Let Icon(ByVal vData As ttIconType)
  195.    mvarIcon = vData
  196.    If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then
  197.       SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
  198.    End If
  199. End Property
  200.  
  201. Public Property Get Icon() As ttIconType
  202.    Icon = mvarIcon
  203. End Property
  204.  
  205. Public Property Let ForeColor(ByVal vData As Long)
  206.    mvarForeColor = vData
  207.    If m_lTTHwnd <> 0 Then
  208.       SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0&
  209.    End If
  210. End Property
  211.  
  212. Public Property Get ForeColor() As Long
  213.    ForeColor = mvarForeColor
  214. End Property
  215.  
  216. Public Property Let Title(ByVal vData As String)
  217.    mvarTitle = vData
  218.    If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then
  219.       SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
  220.    End If
  221. End Property
  222.  
  223. Public Property Get Title() As String
  224.    Title = ti.lpStr
  225. End Property
  226.  
  227. Public Property Let BackColor(ByVal vData As Long)
  228.    mvarBackColor = vData
  229.    If m_lTTHwnd <> 0 Then
  230.       SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0&
  231.    End If
  232. End Property
  233.  
  234. Public Property Get BackColor() As Long
  235.    BackColor = mvarBackColor
  236. End Property
  237.  
  238. Public Property Let TipText(ByVal vData As String)
  239.    mvarTipText = vData
  240.    ti.lpStr = vData
  241.    If m_lTTHwnd <> 0 Then
  242.       SendMessage m_lTTHwnd, TTM_UPDATETIPTEXTA, 0&, ti
  243.    End If
  244. End Property
  245.  
  246. Public Property Get TipText() As String
  247.    TipText = mvarTipText
  248. End Property
  249.  
  250. Private Sub Class_Initialize()
  251.    InitCommonControls
  252.    mvarDelayTime = 100
  253.    mvarVisibleTime = 50000
  254. End Sub
  255.  
  256. Private Sub Class_Terminate()
  257.    Destroy
  258. End Sub
  259.  
  260. Public Sub Destroy()
  261.    If m_lTTHwnd <> 0 Then
  262.       DestroyWindow m_lTTHwnd
  263.    End If
  264. End Sub
  265.  
  266. Public Property Get VisibleTime() As Long
  267.    VisibleTime = mvarVisibleTime
  268. End Property
  269.  
  270. Public Property Let VisibleTime(ByVal lData As Long)
  271.    mvarVisibleTime = lData
  272. End Property
  273.  
  274. Public Property Get DelayTime() As Long
  275.    DelayTime = mvarDelayTime
  276. End Property
  277.  
  278. Public Property Let DelayTime(ByVal lData As Long)
  279.    mvarDelayTime = lData
  280. End Property
  281.  
  282.