home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / vbasic / Data / Utils / cmdbtnx5.msi / Cabs.w1.cab / EventList.ctl < prev    next >
Encoding:
Text File  |  2000-08-11  |  12.6 KB  |  353 lines
  1. VERSION 5.00
  2. Begin VB.UserControl pucEventList 
  3.    Alignable       =   -1  'True
  4.    BackStyle       =   0  'Transparent
  5.    ClientHeight    =   1980
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   5790
  9.    BeginProperty Font 
  10.       Name            =   "Tahoma"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    ScaleHeight     =   132
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   386
  21.    ToolboxBitmap   =   "EventList.ctx":0000
  22.    Begin VB.CommandButton cmdAbout 
  23.       Caption         =   "&About..."
  24.       Height          =   330
  25.       Left            =   2160
  26.       TabIndex        =   3
  27.       Top             =   1395
  28.       Visible         =   0   'False
  29.       Width           =   1140
  30.    End
  31.    Begin VB.CommandButton cmdExit 
  32.       Caption         =   "E&xit"
  33.       Height          =   330
  34.       Left            =   4500
  35.       TabIndex        =   5
  36.       Top             =   1395
  37.       Visible         =   0   'False
  38.       Width           =   1140
  39.    End
  40.    Begin VB.CommandButton cmdClear 
  41.       Caption         =   "Clear"
  42.       Height          =   330
  43.       Left            =   3330
  44.       TabIndex        =   4
  45.       Top             =   1395
  46.       Width           =   1140
  47.    End
  48.    Begin VB.CheckBox chkStandard 
  49.       Caption         =   "Standard Colours"
  50.       Height          =   285
  51.       Left            =   0
  52.       TabIndex        =   2
  53.       Top             =   1530
  54.       Width           =   1590
  55.    End
  56.    Begin VB.ListBox lstItems 
  57.       Height          =   1020
  58.       IntegralHeight  =   0   'False
  59.       Left            =   0
  60.       TabIndex        =   1
  61.       Top             =   225
  62.       Width           =   5640
  63.    End
  64.    Begin VB.Label lblHdr 
  65.       AutoSize        =   -1  'True
  66.       Caption         =   "E&vents:"
  67.       Height          =   195
  68.       Left            =   0
  69.       TabIndex        =   0
  70.       Top             =   0
  71.       Width           =   555
  72.    End
  73. End
  74. Attribute VB_Name = "pucEventList"
  75. Attribute VB_GlobalNameSpace = False
  76. Attribute VB_Creatable = True
  77. Attribute VB_PredeclaredId = False
  78. Attribute VB_Exposed = False
  79.  
  80. '-----------------------------------------'
  81. '            Ariad Development Components '
  82. '-----------------------------------------'
  83. '               Event List Sample Control '
  84. '                             Version 1.0 '
  85. '-----------------------------------------'
  86. 'Copyright ⌐ 1999 by Ariad Software. All Rights Reserved.
  87.  
  88. 'Created        : 30/08/1999
  89. 'Completed      : 30/08/1999
  90. 'Last Updated   : 23/12/1999
  91.  
  92. '23/09/1999
  93. '           - Extended Add routine for use with multiple parameters
  94. '           - Added horizontal scrollbar to listbox
  95. '           - Added clear button
  96. '26/09/1999
  97. '           - Added BackColor property
  98. '           - Added Standard Colours checkbox
  99. '           - Added StandardColoursVisible property
  100. '           - Added StandardColoursClicked event
  101. '21/11/1999
  102. '           - Constant declares updated
  103. '           - Horizontal scrollbar now automatically sized to largest item
  104. '22/11/1999
  105. '           - Added StandardColoursValue property
  106. '23/12/1999
  107. '           - Exit and About buttons added
  108. '           - ExitVisible and AboutVisible properties added.
  109. '           - ExitClicked and AboutClicked events added
  110.  
  111. Option Explicit
  112. DefInt A-Z
  113.  
  114. 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
  115.  
  116. Public Event StandardColoursClicked(ByVal IsStandard As Boolean)
  117. Public Event ExitClicked()
  118. Public Event AboutClicked()
  119.  
  120. Private Const LB_SETHORIZONTALEXTENT = &H194
  121. Private Const LB_GETHORIZONTALEXTENT = &H193
  122.  
  123. Private Count As Long
  124.  
  125. Private pStandardColoursVisible As Boolean
  126. Private pExitVisible As Boolean
  127. Private pAboutVisible As Boolean
  128. '-------------------------------------------------------------------
  129. 'Name        : AboutVisible
  130. 'Created     : 23/12/1999 11:34
  131. '-------------------------------------------------------------------
  132. 'Author      : Richard Moss
  133. 'Organisation: Ariad Software
  134. '-------------------------------------------------------------------
  135. 'Description : Returns or sets if the About button is visible.
  136. '-------------------------------------------------------------------
  137. 'Returns     : Returns True if the property is set, otherwise False
  138. '-------------------------------------------------------------------
  139. 'Updates     :
  140. '
  141. '-------------------------------------------------------------------
  142. '                           Ariad Procedure Builder Add-In 1.00.0033
  143. Public Property Get AboutVisible() As Boolean
  144. Attribute AboutVisible.VB_Description = "Returns or sets if the About button is visible."
  145.  AboutVisible = pAboutVisible
  146. End Property '(Public) Property Get AboutVisible () As Boolean
  147.  
  148. Property Let AboutVisible(ByVal AboutVisible As Boolean)
  149.  pAboutVisible = AboutVisible
  150.  cmdAbout.Visible = AboutVisible
  151.  UserControl_Resize
  152.  PropertyChanged "AboutVisible"
  153. End Property ' Property Let AboutVisible
  154.  
  155. '-------------------------------------------------------------------
  156. 'Name        : ExitVisible
  157. 'Created     : 23/12/1999 11:33
  158. '-------------------------------------------------------------------
  159. 'Author      : Richard Moss
  160. 'Organisation: Ariad Software
  161. '-------------------------------------------------------------------
  162. 'Description : Returns or sets if the exit button is visible.
  163. '-------------------------------------------------------------------
  164. 'Returns     : Returns True if the property is set, otherwise False
  165. '-------------------------------------------------------------------
  166. 'Updates     :
  167. '
  168. '-------------------------------------------------------------------
  169. '                           Ariad Procedure Builder Add-In 1.00.0033
  170. Public Property Get ExitVisible() As Boolean
  171. Attribute ExitVisible.VB_Description = "Returns or sets if the exit button is visible."
  172.  ExitVisible = pExitVisible
  173. End Property '(Public) Property Get ExitVisible () As Boolean
  174.  
  175. Property Let ExitVisible(ByVal ExitVisible As Boolean)
  176.  pExitVisible = ExitVisible
  177.  cmdExit.Visible = ExitVisible
  178.  UserControl_Resize
  179.  PropertyChanged "ExitVisible"
  180. End Property ' Property Let ExitVisible
  181.  
  182.  
  183. '----------------------------------------------------------------------
  184. 'Name        : StandardColoursValue
  185. 'Created     : 22/11/1999 14:45
  186. '----------------------------------------------------------------------
  187. 'Author      : Richard Moss
  188. 'Organisation: Ariad Software
  189. '----------------------------------------------------------------------
  190. 'Description : Returns or sets the value of the Standard Colours
  191. '              checkbox.
  192. '----------------------------------------------------------------------
  193. 'Returns     : Returns True if the property is set, otherwise False
  194. '----------------------------------------------------------------------
  195. 'Updates     :
  196. '
  197. '----------------------------------------------------------------------
  198. '                              Ariad Procedure Builder Add-In 1.00.0033
  199. Public Property Get StandardColoursValue() As Boolean
  200. Attribute StandardColoursValue.VB_Description = "Returns or sets the value of the Standard Colours checkbox."
  201.  StandardColoursValue = chkStandard
  202. End Property '(Public) Property Get StandardColoursValue () As Boolean
  203.  
  204. Property Let StandardColoursValue(ByVal StandardColoursValue As Boolean)
  205.  chkStandard = Abs(StandardColoursValue)
  206.  PropertyChanged "StandardColoursValue"
  207. End Property ' Property Let StandardColoursValue
  208.  
  209. '----------------------------------------------------------------------
  210. 'Name        : BackColor
  211. 'Created     : 26/09/1999 17:03
  212. '----------------------------------------------------------------------
  213. 'Author      : Richard James Moss
  214. 'Organisation: Ariad Software
  215. '----------------------------------------------------------------------
  216. 'Description : Returns/sets the background colour of the UserControl
  217. '              and some child controls.
  218. '----------------------------------------------------------------------
  219. 'Returns     : Returns an OLE_COLOR Variable
  220. '----------------------------------------------------------------------
  221. 'Updates     :
  222. '
  223. '----------------------------------------------------------------------
  224. '                              Ariad Procedure Builder Add-In 1.00.0027
  225. Public Property Get BackColor() As OLE_COLOR
  226.  BackColor = UserControl.BackColor
  227. End Property '(Public) Property Get BackColor () As OLE_COLOR
  228.  
  229. Property Let BackColor(ByVal BackColor As OLE_COLOR)
  230.  UserControl.BackColor = BackColor
  231.  chkStandard.BackColor = BackColor
  232.  lblHdr.BackColor = BackColor
  233.  PropertyChanged "BackColor"
  234. End Property ' Property Let BackColor
  235.  
  236. '----------------------------------------------------------------------
  237. 'Name        : StandardColoursVisible
  238. 'Created     : 26/09/1999 16:54
  239. '----------------------------------------------------------------------
  240. 'Author      : Richard James Moss
  241. 'Organisation: Ariad Software
  242. '----------------------------------------------------------------------
  243. 'Description : Determines if the Standard Colours checkbox is visible.
  244. '----------------------------------------------------------------------
  245. 'Returns     : Returns True if the property is set, otherwise False
  246. '----------------------------------------------------------------------
  247. 'Updates     :
  248. '
  249. '----------------------------------------------------------------------
  250. '                              Ariad Procedure Builder Add-In 1.00.0027
  251. Public Property Get StandardColoursVisible() As Boolean
  252.  StandardColoursVisible = pStandardColoursVisible
  253. End Property '(Public) Property Get StandardColoursVisible () As Boolean
  254.  
  255. Property Let StandardColoursVisible(ByVal StandardColoursVisible As Boolean)
  256.  pStandardColoursVisible = StandardColoursVisible
  257.  chkStandard.Visible = StandardColoursVisible
  258.  PropertyChanged "StandardColoursVisible"
  259. End Property ' Property Let StandardColoursVisible
  260.  
  261.  
  262. Sub Add(Procedure$, ParamArray Vars() As Variant)
  263.  Dim I
  264.  Dim Data$, VarName$
  265.  Dim Width As Long
  266.  Count = Count + 1
  267.  Data$ = Count & vbTab & Procedure$ & "("
  268.  For I = LBound(Vars) To UBound(Vars)
  269.   VarName$ = CStr(Vars(I))
  270.   If VarType(Vars(I)) = vbString Then
  271.    VarName$ = Chr$(34) & VarName$ & Chr$(34)
  272.   End If
  273.   Data$ = Data$ & VarName$
  274.   If I <> UBound(Vars) Then Data$ = Data$ & ", "
  275.  Next
  276.  Data$ = Data$ & ")"
  277.  lstItems.AddItem Data$
  278.  lstItems.ListIndex = lstItems.NewIndex
  279.  'add hscroll if required...
  280.  Width = SendMessage(lstItems.hWnd, LB_GETHORIZONTALEXTENT, 0, 0)
  281.  If TextWidth(Data$) + 40 > Width Then
  282.   SendMessage lstItems.hWnd, LB_SETHORIZONTALEXTENT, ByVal TextWidth(Data$) + 40, ByVal 0&
  283.  End If
  284. End Sub
  285.  
  286.  
  287. Sub Clear()
  288.  lstItems.Clear
  289. End Sub
  290.  
  291.  
  292. Private Sub chkStandard_Click()
  293.  RaiseEvent StandardColoursClicked(chkStandard)
  294. End Sub
  295.  
  296. Private Sub cmdAbout_Click()
  297.  RaiseEvent AboutClicked
  298. End Sub
  299.  
  300. Private Sub cmdClear_Click()
  301.  Count = 0
  302.  lstItems.Clear
  303. End Sub
  304.  
  305. Private Sub cmdExit_Click()
  306.  If pExitVisible Then
  307.   RaiseEvent ExitClicked
  308.  End If
  309. End Sub
  310.  
  311. Private Sub UserControl_InitProperties()
  312.  StandardColoursVisible = 0
  313.  ExitVisible = 0
  314.  AboutVisible = 0
  315.  UserControl_Resize
  316. End Sub
  317.  
  318.  
  319. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  320.  With PropBag
  321.   StandardColoursVisible = .ReadProperty("StandardColoursVisible", 0)
  322.   BackColor = .ReadProperty("BackColor", vbButtonFace)
  323.   StandardColoursValue = .ReadProperty("StandardColoursValue", 0)
  324.   AboutVisible = .ReadProperty("AboutVisible", 0)
  325.   ExitVisible = .ReadProperty("ExitVisible", 0)
  326.  End With
  327.  UserControl_Resize
  328. End Sub
  329. Private Sub UserControl_Resize()
  330.  On Error Resume Next
  331.   lstItems.Move 0, lblHdr.Height + 2, ScaleWidth, ScaleHeight - (lblHdr.Height + 5 + cmdClear.Height)
  332.   If pExitVisible = 0 Then
  333.    cmdClear.Move ScaleWidth - cmdClear.Width, ScaleHeight - cmdClear.Height
  334.   Else
  335.    cmdExit.Move ScaleWidth - cmdExit.Width, ScaleHeight - cmdExit.Height
  336.    cmdClear.Move cmdExit.Left - (cmdClear.Width + 3), cmdExit.Top
  337.   End If
  338.   cmdAbout.Move cmdClear.Left - (cmdClear.Width + 3), cmdClear.Top
  339.   chkStandard.Top = cmdClear.Top + ((cmdClear.Height - chkStandard.Height) / 2)
  340.  On Error GoTo 0
  341. End Sub
  342.  
  343.  
  344. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  345.  With PropBag
  346.   .WriteProperty "StandardColoursVisible", pStandardColoursVisible, 0
  347.   .WriteProperty "BackColor", BackColor, vbButtonFace
  348.   .WriteProperty "StandardColoursValue", StandardColoursValue, 0
  349.   .WriteProperty "AboutVisible", pAboutVisible, 0
  350.   .WriteProperty "ExitVisible", pExitVisible, 0
  351.  End With
  352. End Sub
  353.