home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / vbasic / Data / Utils / ahtmlle2.exe / MAINDIR / EventList.ctl < prev    next >
Encoding:
Text File  |  2001-08-07  |  13.4 KB  |  370 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(ByVal Method As String, ParamArray Parameters() As Variant)
  263.     Dim Data        As String
  264.     Dim Value       As String
  265.     Dim IndexLoop   As Integer
  266.     Dim Width       As Long
  267.     'determine parameter string
  268.     If UBound(Parameters) >= 0 Then
  269.         Data = "("
  270.         For IndexLoop = LBound(Parameters) To UBound(Parameters)
  271.             If IsObject(Parameters(IndexLoop)) Then
  272.                 If Parameters(IndexLoop) Is Nothing Then
  273.                     Value = "{Nothing}"
  274.                 Else
  275.                     Value = "{Object:" & TypeName(Parameters(IndexLoop)) & "}"
  276.                 End If
  277.             Else
  278.                 Value = CStr(Parameters(IndexLoop))
  279.             End If
  280.             If VarType(Parameters(IndexLoop)) = vbString Then
  281.                 Value = Chr$(34) & Value & Chr$(34)
  282.             ElseIf VarType(Parameters(IndexLoop)) = vbError Then
  283.                 Value = Chr$(34) & Chr$(34)
  284.             End If
  285.             Data = Data & Value
  286.             If IndexLoop <> UBound(Parameters) Then
  287.                 Data = Data & ", "
  288.             End If
  289.         Next
  290.         Data = Data & ")"
  291.     End If
  292.     Data = Method & " " & Data
  293.     'add it
  294.     lstItems.AddItem Data
  295.     lstItems.ListIndex = lstItems.NewIndex
  296.     'add hscroll if required...
  297.     Width = SendMessage(lstItems.hWnd, LB_GETHORIZONTALEXTENT, 0, 0)
  298.     If TextWidth(Data) + 40 > Width Then
  299.         SendMessage lstItems.hWnd, LB_SETHORIZONTALEXTENT, ByVal TextWidth(Data) + 40, ByVal 0&
  300.     End If
  301. End Sub
  302.  
  303.  
  304. Sub Clear()
  305.  lstItems.Clear
  306. End Sub
  307.  
  308.  
  309. Private Sub chkStandard_Click()
  310.  RaiseEvent StandardColoursClicked(chkStandard)
  311. End Sub
  312.  
  313. Private Sub cmdAbout_Click()
  314.  RaiseEvent AboutClicked
  315. End Sub
  316.  
  317. Private Sub cmdClear_Click()
  318.  Count = 0
  319.  lstItems.Clear
  320. End Sub
  321.  
  322. Private Sub cmdExit_Click()
  323.  If pExitVisible Then
  324.   RaiseEvent ExitClicked
  325.  End If
  326. End Sub
  327.  
  328. Private Sub UserControl_InitProperties()
  329.  StandardColoursVisible = 0
  330.  ExitVisible = 0
  331.  AboutVisible = 0
  332.  UserControl_Resize
  333. End Sub
  334.  
  335.  
  336. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  337.  With PropBag
  338.   StandardColoursVisible = .ReadProperty("StandardColoursVisible", 0)
  339.   BackColor = .ReadProperty("BackColor", vbButtonFace)
  340.   StandardColoursValue = .ReadProperty("StandardColoursValue", 0)
  341.   AboutVisible = .ReadProperty("AboutVisible", 0)
  342.   ExitVisible = .ReadProperty("ExitVisible", 0)
  343.  End With
  344.  UserControl_Resize
  345. End Sub
  346. Private Sub UserControl_Resize()
  347.  On Error Resume Next
  348.   lstItems.Move 0, lblHdr.Height + 2, ScaleWidth, ScaleHeight - (lblHdr.Height + 5 + cmdClear.Height)
  349.   If pExitVisible = 0 Then
  350.    cmdClear.Move ScaleWidth - cmdClear.Width, ScaleHeight - cmdClear.Height
  351.   Else
  352.    cmdExit.Move ScaleWidth - cmdExit.Width, ScaleHeight - cmdExit.Height
  353.    cmdClear.Move cmdExit.Left - (cmdClear.Width + 3), cmdExit.Top
  354.   End If
  355.   cmdAbout.Move cmdClear.Left - (cmdClear.Width + 3), cmdClear.Top
  356.   chkStandard.Top = cmdClear.Top + ((cmdClear.Height - chkStandard.Height) / 2)
  357.  On Error GoTo 0
  358. End Sub
  359.  
  360.  
  361. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  362.  With PropBag
  363.   .WriteProperty "StandardColoursVisible", pStandardColoursVisible, 0
  364.   .WriteProperty "BackColor", BackColor, vbButtonFace
  365.   .WriteProperty "StandardColoursValue", StandardColoursValue, 0
  366.   .WriteProperty "AboutVisible", pAboutVisible, 0
  367.   .WriteProperty "ExitVisible", pExitVisible, 0
  368.  End With
  369. End Sub
  370.