home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Priory_Hot1879694212005.psc / clsBarItem.cls < prev    next >
Text File  |  2005-04-21  |  11KB  |  387 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 = "clsBarItem"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'Copyright (C) 2004 Kristian. S.Stangeland
  17.  
  18. 'This program is free software; you can redistribute it and/or
  19. 'modify it under the terms of the GNU General Public License
  20. 'as published by the Free Software Foundation; either version 2
  21. 'of the License, or (at your option) any later version.
  22.  
  23. 'This program is distributed in the hope that it will be useful,
  24. 'but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. 'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26. 'GNU General Public License for more details.
  27.  
  28. 'You should have received a copy of the GNU General Public License
  29. 'along with this program; if not, write to the Free Software
  30. 'Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  31.  
  32. Enum ItemType
  33.     ItemType_Link = 0                'The default. An item which highlights like a Hyperlink whilst the mouse is over, and can be clicked.
  34.     ItemType_ControlPlaceHolder = 1  'A textual label. This type cannot be highlighted or clicked.
  35.     ItemType_Object = 2              'A placeholder for another ActiveX control. The control is set using the Control property.
  36. End Enum
  37.  
  38. Private m_lIndex As Long
  39. Private m_sText As String
  40. Private m_sTag As String
  41. Private m_bBold As Boolean
  42. Private m_vControl As Object
  43. Private m_lParent As Object
  44. Private m_lItemData As Variant
  45. Private m_bCanClick As Boolean
  46. Private m_lSpacingAfter As Long
  47. Private m_lIconHandle As StdPicture
  48. Private m_sToolTipText As String
  49. Private m_lClassMember As ItemType
  50. Private m_lTextColor As OLE_COLOR
  51. Private m_lTextColorOver As OLE_COLOR
  52. Private m_bInvokeEvents As Boolean
  53. Private m_bSelected As Boolean
  54.  
  55. Public Property Get Text() As String
  56.  
  57.     Text = m_sText
  58.     
  59. End Property
  60.  
  61. Public Property Let Text(ByVal sText As String)
  62.  
  63.     If m_sText <> sText Then
  64.         m_sText = sText
  65.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Text"
  66.     End If
  67.     
  68. End Property
  69.  
  70. Public Property Get Tag() As String
  71.  
  72.     Tag = m_sTag
  73.     
  74. End Property
  75.  
  76. Public Property Let Tag(ByVal sTag As String)
  77.  
  78.     If m_sTag <> sTag Then
  79.         m_sTag = sTag
  80.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Tag"
  81.     End If
  82.     
  83. End Property
  84.  
  85. Public Property Get Bold() As Boolean
  86.  
  87.     Bold = m_bBold
  88.     
  89. End Property
  90.  
  91. Public Property Let Bold(ByVal bBold As Boolean)
  92.  
  93.     If m_bBold <> bBold Then
  94.         m_bBold = bBold
  95.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Bold"
  96.     End If
  97.     
  98. End Property
  99.  
  100. Public Property Get Control() As Object
  101.  
  102.     Set Control = m_vControl
  103.     
  104. End Property
  105.  
  106. Public Property Let Control(ByVal vControl As Object)
  107.  
  108.     If Not m_vControl Is vControl Then
  109.         Set m_vControl = vControl
  110.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Control"
  111.     End If
  112.     
  113. End Property
  114.  
  115. Public Property Get ItemData() As Variant
  116.  
  117.     ItemData = m_lItemData
  118.     
  119. End Property
  120.  
  121. Public Property Let ItemData(ByVal lItemData As Variant)
  122.  
  123.     If m_lItemData <> lItemData Then
  124.         m_lItemData = lItemData
  125.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "ItemData"
  126.     End If
  127.     
  128. End Property
  129.  
  130. Public Property Get CanClick() As Boolean
  131.  
  132.     CanClick = m_bCanClick
  133.     
  134. End Property
  135.  
  136. Public Property Let CanClick(ByVal bCanClick As Boolean)
  137.  
  138.     If m_bCanClick <> bCanClick Then
  139.         m_bCanClick = bCanClick
  140.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "CanClick"
  141.     End If
  142.     
  143. End Property
  144.  
  145. Public Property Get SpacingAfter() As Long
  146.  
  147.     SpacingAfter = m_lSpacingAfter
  148.     
  149. End Property
  150.  
  151. Public Property Let SpacingAfter(ByVal lSpacingAfter As Long)
  152.  
  153.     If m_lSpacingAfter <> lSpacingAfter Then
  154.         m_lSpacingAfter = lSpacingAfter
  155.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "SpacingAfter"
  156.     End If
  157.     
  158. End Property
  159.  
  160. Public Property Get IconHandle() As StdPicture
  161.  
  162.     Set IconHandle = m_lIconHandle
  163.     
  164. End Property
  165.  
  166. Public Property Let IconHandle(ByVal lIconHandle As StdPicture)
  167.  
  168.     If Not m_lIconHandle Is lIconHandle Then
  169.         Set m_lIconHandle = lIconHandle
  170.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "IconHandle"
  171.     End If
  172.     
  173. End Property
  174.  
  175. Public Property Get ToolTipText() As String
  176.  
  177.     ToolTipText = m_sToolTipText
  178.     
  179. End Property
  180.  
  181. Public Property Let ToolTipText(ByVal sToolTipText As String)
  182.  
  183.     If m_sToolTipText <> sToolTipText Then
  184.         m_sToolTipText = sToolTipText
  185.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "ToolTipText"
  186.     End If
  187.     
  188. End Property
  189.  
  190. Public Property Get TextColor() As OLE_COLOR
  191.  
  192.     TextColor = m_lTextColor
  193.     
  194. End Property
  195.  
  196. Public Property Let TextColor(ByVal lTextColor As OLE_COLOR)
  197.  
  198.     If m_lTextColor <> lTextColor Then
  199.         m_lTextColor = lTextColor
  200.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "TextColor"
  201.     End If
  202.     
  203. End Property
  204.  
  205. Public Property Get TextColorOver() As OLE_COLOR
  206.  
  207.     TextColorOver = m_lTextColorOver
  208.     
  209. End Property
  210.  
  211. Public Property Let TextColorOver(ByVal lTextColorOver As OLE_COLOR)
  212.  
  213.     If m_lTextColorOver <> lTextColorOver Then
  214.         m_lTextColorOver = lTextColorOver
  215.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "TextColorOver"
  216.     End If
  217.     
  218. End Property
  219.  
  220. Public Property Get Parent() As Object
  221.  
  222.     Set Parent = m_lParent
  223.     
  224. End Property
  225.  
  226. Public Property Let Parent(ByVal lParent As Object)
  227.  
  228.     If Not m_lParent Is lParent Then
  229.         Set m_lParent = lParent
  230.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Parent"
  231.     End If
  232.     
  233. End Property
  234.  
  235. Public Property Get ClassMember() As ItemType
  236.  
  237.     ClassMember = m_lClassMember
  238.     
  239. End Property
  240.  
  241. Public Property Let ClassMember(ByVal lClassMember As ItemType)
  242.  
  243.     If m_lClassMember <> lClassMember Then
  244.         m_lClassMember = lClassMember
  245.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "ClassMember"
  246.     End If
  247.     
  248. End Property
  249.  
  250. Public Property Get Selected() As Boolean
  251.  
  252.     Selected = m_bSelected
  253.     
  254. End Property
  255.  
  256. Public Property Let Selected(ByVal bSelected As Boolean)
  257.  
  258.     If m_bSelected <> bSelected Then
  259.         m_bSelected = bSelected
  260.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Selected"
  261.     End If
  262.     
  263. End Property
  264.  
  265. Public Property Get Index() As Long
  266.  
  267.     Index = m_lIndex
  268.     
  269. End Property
  270.  
  271. Public Property Let Index(ByVal lIndex As Long)
  272.  
  273.     If m_lIndex <> lIndex Then
  274.         m_lIndex = lIndex
  275.         If m_bInvokeEvents Then m_lParent.Parent.HandleEvent BarEvent_ItemChanged, Me, "Index"
  276.     End If
  277.     
  278. End Property
  279.  
  280. Public Property Get InvokeEvents() As Boolean
  281.  
  282.     InvokeEvents = m_bInvokeEvents
  283.     
  284. End Property
  285.  
  286. Public Property Let InvokeEvents(ByVal bInvokeEvents As Boolean)
  287.  
  288.     m_bInvokeEvents = bInvokeEvents
  289.     
  290. End Property
  291.  
  292. Public Property Get Height() As Long
  293.     
  294.     Dim Tmp As Long, IconHeight As Long, lWidth As Long
  295.     
  296.     Select Case m_lClassMember
  297.     Case ItemType_Object
  298.         
  299.         If Not Control Is Nothing Then
  300.         
  301.             ' A MDIForm hasn't got the property "ScaleMode", so here it will always be twips
  302.             If TypeOf Control.Parent Is MDIForm Then
  303.                 ' Only pictureboxes can be placed as "top" childrens (almost), so we must check what type the object is
  304.                 If TypeOf Control Is PictureBox Then
  305.                     Tmp = m_lParent.Parent.ScaleY(Control.Height, vbTwips, vbPixels)
  306.                 Else
  307.                     ' If not, then just assume it's Pixels, since we cannot really find it out due to the language.
  308.                     Tmp = Control.Height
  309.                 End If
  310.             Else
  311.                 Tmp = m_lParent.Parent.ScaleY(Control.Height, Control.Parent.ScaleMode, vbPixels)
  312.                 'Debug.Print Control.Height
  313.                 'Debug.Print Control.Name
  314.             End If
  315.             
  316.         End If
  317.  
  318.     Case Else
  319.     
  320.         ' Get the size of a normal A
  321.         Tmp = m_lParent.Parent.TextHeight("A")
  322.                 
  323.         ' It's faster to access a variable than a property
  324.         lWidth = Width
  325.         
  326.         ' Then, assure that we don't have more lines
  327.         If lWidth > BarTitle_Width - BarTitle_ItemLeft - m_lSpacingAfter Then
  328.             Tmp = Tmp * (Int(lWidth / (BarTitle_Width + BarTitle_Left - m_lSpacingAfter)) + 1)
  329.         End If
  330.     
  331.         ' Make sure that the icon isn't bigger than the text
  332.         If Not m_lIconHandle Is Nothing Then
  333.         
  334.             IconHeight = m_lParent.Parent.ScaleY(m_lIconHandle.Height, vbHimetric, vbPixels)
  335.         
  336.             If IconHeight > Tmp Then
  337.                 Tmp = IconHeight
  338.             End If
  339.         
  340.         End If
  341.     
  342.     End Select
  343.     
  344.     ' Return the height
  345.     Height = Tmp
  346.     
  347. End Property
  348.  
  349. Public Property Get Width() As Long
  350.     
  351.     Dim Tmp As Long
  352.     
  353.     Select Case m_lClassMember
  354.     Case ItemType_Object
  355.         
  356.         If Not Control Is Nothing Then
  357.         
  358.             ' A MDIForm hasn't got the property "ScaleMode", so here it will always be twips
  359.             If TypeOf Control.Parent Is MDIForm Then
  360.                 Tmp = m_lParent.Parent.ScaleX(Control.Width, vbTwips, vbPixels)
  361.             Else
  362.                 Tmp = m_lParent.Parent.ScaleX(Control.Width, Control.Parent.ScaleMode, vbPixels)
  363.             End If
  364.             
  365.         End If
  366.  
  367.     Case Else
  368.     
  369.         ' Get the width of the text
  370.         Tmp = m_lParent.Parent.TextWidth(m_sText)
  371.     
  372.     End Select
  373.     
  374.     ' Return the height
  375.     Width = Tmp
  376.     
  377. End Property
  378.  
  379. Private Sub Class_Initialize()
  380.  
  381.     ' Default settings
  382.     m_lTextColorOver = RGB(129, 180, 255)
  383.     m_lTextColor = vbBlack
  384.     m_bCanClick = True
  385.  
  386. End Sub
  387.