home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD83117282000.psc / ActXListView.ctl (.txt) next >
Encoding:
Visual Basic Form  |  2000-06-12  |  12.4 KB  |  348 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.UserControl SQLListView 
  4.    ClientHeight    =   1470
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    Picture         =   "ActXListView.ctx":0000
  9.    ScaleHeight     =   1470
  10.    ScaleWidth      =   4800
  11.    ToolboxBitmap   =   "ActXListView.ctx":06CA
  12.    Begin MSComctlLib.ListView LV 
  13.       Height          =   795
  14.       Left            =   0
  15.       TabIndex        =   1
  16.       Top             =   0
  17.       Width           =   2835
  18.       _ExtentX        =   5001
  19.       _ExtentY        =   1402
  20.       LabelWrap       =   -1  'True
  21.       HideSelection   =   0   'False
  22.       FullRowSelect   =   -1  'True
  23.       _Version        =   393217
  24.       ForeColor       =   -2147483640
  25.       BackColor       =   -2147483643
  26.       BorderStyle     =   1
  27.       Appearance      =   1
  28.       NumItems        =   0
  29.    End
  30.    Begin VB.TextBox Text1 
  31.       Height          =   330
  32.       Left            =   105
  33.       TabIndex        =   0
  34.       Text            =   "Text1"
  35.       Top             =   840
  36.       Visible         =   0   'False
  37.       Width           =   1380
  38.    End
  39. Attribute VB_Name = "SQLListView"
  40. Attribute VB_GlobalNameSpace = False
  41. Attribute VB_Creatable = True
  42. Attribute VB_PredeclaredId = False
  43. Attribute VB_Exposed = True
  44. '///Changes - 8/30/98 hid the propety Listindex from property page
  45. Private m_strColumn     As String
  46. Private m_intListindex  As Integer
  47. Private m_bolEnabled    As Boolean
  48. Private m_strCompareVal As String
  49. Private m_Rs            As Object   '   This is for Recordset
  50. 'Event Declarations:
  51. Event Change()
  52. Event Click()
  53. Event dblClick()
  54. Event Keydown(KeyCode As Integer, Shift As Integer)
  55. Event KeyPress(KeyAscii As Integer)
  56. Event KeyUp(KeyCode As Integer, Shift As Integer)
  57. Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  58. Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  59. Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  60. '************* PROPERTIES **************************************
  61. Public Property Get Value(Optional intIndex As Integer = 0) As Variant
  62. '    Get the Value for the control which is the text in
  63. '    the indicated column (intIndex).  If not column is
  64. '    passed then the first/left column is the default
  65. '    Parameters: column index
  66. '    Returns: control value, NULL = nothing selected
  67.     ' Any error results in a NULL value
  68.     On Error Resume Next
  69.     If intIndex = 0 Then
  70.         If LV.SelectedItem.Selected = False Then
  71.             m_value = Null
  72.         Else
  73.             m_value = LV.SelectedItem
  74.         End If
  75.     Else
  76.         If LV.SelectedItem.Selected = False Then
  77.             m_value = Null
  78.         Else
  79.             m_value = LV.SelectedItem.SubItems(intIndex)
  80.         End If
  81.     End If
  82.     If Err <> 0 Then m_value = Null
  83.     Value = m_value
  84. End Property
  85. Public Property Get ColumnHeader(intIndex As Integer) As String
  86. '    Get the Text for the columnheader indicated by the
  87. '    index parameter
  88. '    Parameters: column index
  89. '    Returns: Text for the indicated columnheader
  90.     On Error GoTo ERR_HANDLER
  91.     m_value = LV.ColumnHeaders(intIndex + 1).Text
  92.     ColumnHeader = m_value
  93.     Exit Property
  94. ERR_HANDLER:
  95.     Call Object_Err_Handler
  96. End Property
  97. Public Property Get ColumnHeaderCount() As Integer
  98. '    Get the number of Columnheaders/Query Fields
  99. '    Parameters: none
  100. '    Returns: number of Columnheaders/Query Fields
  101. On Error GoTo ERR_HANDLER
  102.     m_ColumnHeaderCount = LV.ColumnHeaders.Count
  103.     ColumnHeaderCount = m_ColumnHeaderCount
  104.     Exit Property
  105. ERR_HANDLER:
  106.     Call Object_Err_Handler
  107. End Property
  108. Public Property Get Listindex() As Integer
  109. '    Get the index of the selected listitem
  110. '    Parameters: none
  111. '    Returns: index of the selected listitem
  112.     On Error Resume Next
  113.     ' This is a test for design mode - if sql is empty then
  114.     ' the app. can't be running.  Otherwise, this sub triggers
  115.     ' an error in design mode.  Note ActiveX controls are "live"
  116.     ' in BOTH design and runtime.
  117.     If m_Rs Is Nothing Then Exit Property
  118.     If LV.SelectedItem.Selected = False Then
  119.         m_intListindex = 0
  120.     Else
  121.         m_intListindex = LV.SelectedItem.Index
  122.     End If
  123.     Listindex = m_intListindex
  124.     If Err <> 0 Then m_intListindex = 0
  125. End Property
  126. Public Property Let Listindex(New_ListIndex As Integer)
  127. '    Sets the listindex property and highlights the corresponding
  128. '    listitem
  129. '    Parameters: listindex value
  130. '    Returns: N/A
  131.     ' For 0 set all items to selected = false
  132. On Error GoTo ERR_HANDLER
  133.     If New_ListIndex = 0 Then
  134.         For C = 1 To LV.ListItems.Count
  135.             ' get the selected item and unselect it
  136.             If LV.ListItems(C).Selected = True Then
  137.                 LV.ListItems(C).Selected = False
  138.                 Exit For
  139.             End If
  140.         Next
  141.         m_strCompareVal = "" 'set Change check = ""
  142.     Else
  143.         LV.ListItems(New_ListIndex).Selected = True
  144.     End If
  145.     m_intListindex = New_ListIndex
  146.     PropertyChanged "Listindex"
  147.     'Change only for a non 0 listindex
  148.     If New_ListIndex <> 0 Then RaiseEvent Change
  149.     Exit Property
  150. ERR_HANDLER:
  151.     Call Object_Err_Handler
  152. End Property
  153. Public Property Let Rs(new_Rs As Object)
  154.     Set m_Rs = new_Rs
  155. End Property
  156. Public Property Get Rs() As Object
  157.     Rs = m_Rs
  158. End Property
  159. Public Property Let Enabled(newEnabled As Boolean)
  160. '    Sets the Enabled property to control to True or False
  161. '    Parameters: True to Enable, False to Disable control
  162. '    Returns: N/A
  163.     m_bolEnabled = newEnabled
  164.     LV.Enabled = m_bolEnabled
  165.     PropertyChanged "Enabled"
  166. End Property
  167. Public Property Get Enabled() As Boolean
  168. '    Gets the Enabled property of control (True or False)
  169. '    Parameters: None
  170. '    Returns: True - control is enabled, False - control is disabled
  171.     Enabled = m_bolEnabled
  172. End Property
  173. Private Sub LV_BeforeLabelEdit(Cancel As Integer)
  174. '    Overrides Defaul ListView functionality that allows
  175. '    Users to type into the listitems 1st column
  176. '    and overwrite the text
  177.     Cancel = True
  178. End Sub
  179. '************  EVENTS ***************************
  180. Private Sub LV_Click()
  181.     RaiseEvent Click
  182. End Sub
  183. Private Sub LV_DblClick()
  184.     RaiseEvent dblClick
  185. End Sub
  186. Private Sub LV_ItemClick(ByVal Item As MSComctlLib.ListItem)
  187.     ' compare previous LV.selecteditem value (m_strCompareVal)
  188.     ' to current LV.selecteditem - if different raise the CHANGE
  189.     ' event. Note - [CHANGE] will be raised BEFORE [CLICK] if a
  190.     ' [change] has occurred after the [click].  Otherwise just [click]
  191.     ' will be raised.
  192.     If m_strCompareVal <> LV.SelectedItem Then
  193.         RaiseEvent Change
  194.         m_strCompareVal = LV.SelectedItem
  195.     End If
  196. End Sub
  197. Private Sub LV_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  198.     On Error GoTo ERR_HANDLER
  199.     RaiseEvent MouseDown(Button, Shift, x, y)
  200.     ' Prevents error that would occurr on last line
  201.     If LV.ListItems.Count = 0 Then Exit Sub
  202.     Exit Sub
  203. ERR_HANDLER:
  204.     Call Object_Err_Handler
  205. End Sub
  206. Private Sub LV_KeyDown(KeyCode As Integer, Shift As Integer)
  207. On Error GoTo ERR_HANDLER
  208.     RaiseEvent Keydown(KeyCode, Shift)
  209.     Exit Sub
  210. ERR_HANDLER:
  211.     Call Object_Err_Handler
  212. End Sub
  213. 'Initialize Properties for User Control
  214. Private Sub UserControl_InitProperties()
  215.     'Default state for this control is ENABLED
  216.     m_bolEnabled = True
  217. End Sub
  218. 'Load property values from storage
  219. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  220.     Enabled = PropBag.ReadProperty("Enabled", m_bolEnabled)
  221. End Sub
  222. 'Write property values to storage
  223. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  224.     Call PropBag.WriteProperty("Enabled", m_bolEnabled)
  225. End Sub
  226. Private Sub LV_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  227.     On Error GoTo ERR_HANDLER
  228.     LV.SortKey = ColumnHeader.Index - 1
  229.     ' Sort Ascending/Descending
  230.     If m_strColumn = ColumnHeader Then
  231.         If LV.SortOrder = lvwDescending Then
  232.             LV.SortOrder = lvwAscending
  233.         Else
  234.             LV.SortOrder = lvwDescending
  235.         End If
  236.     End If
  237.     m_strColumn = ColumnHeader
  238.     LV.Sorted = True
  239.     Exit Sub
  240. ERR_HANDLER:
  241.     Call Object_Err_Handler
  242. End Sub
  243. '***************** USER CONTROL EVENTS ******************
  244. Private Sub UserControl_Resize()
  245. '    Allows Constituant ListView contol to allways FILL the
  246. '    UserControl dimensions in Design mode.  Gives appearance
  247. '    that developer is actually resizing ListView control.
  248.     On Error GoTo ERR_HANDLER
  249.     LV.Height = Text1.Parent.Height
  250.     LV.Width = Text1.Parent.Width
  251.     Exit Sub
  252. ERR_HANDLER:
  253.     Call Object_Err_Handler
  254. End Sub
  255. '********* METHODS *****************************************
  256. Public Sub Clear()
  257.     LV.ListItems.Clear
  258. End Sub
  259. Public Sub Requery(Optional ClearHeaders As Boolean = False)
  260.  Dim intTotCount As Integer
  261.  Dim intCount1 As Integer, intCount2 As Integer
  262.  Dim colNew As ColumnHeader, NewLine As ListItem
  263.     On Error GoTo ERR_HANDLER
  264.     ' Clear the ListView control.
  265.     LV.ListItems.Clear
  266.     If m_Rs Is Nothing Then Exit Sub
  267.     ' Reset columnheaders if necessary
  268.     If ClearHeaders Or LV.ColumnHeaders.Count = 0 Then
  269.         LV.ColumnHeaders.Clear
  270.         For intCount1 = 0 To m_Rs.Fields.Count - 1
  271.             Set colNew = LV.ColumnHeaders.Add(, , m_Rs(intCount1).Name)
  272.         Next intCount1
  273.     End If
  274.     LV.View = 3    ' Set View property to 'Report'.
  275.     If m_Rs.RecordCount = 0 Then Exit Sub
  276.     ' Set Total Records Counter.
  277.     m_Rs.MoveLast
  278.     intTotCount = m_Rs.RecordCount
  279.     m_Rs.MoveFirst
  280.     ' Loop through recordset and add Items to the control.
  281.     For intCount1 = 1 To intTotCount
  282.         '///[changed] 8/25/98 to allow for formatted numbers (I.e. $5,000)
  283.         '[changed] 8/25/98 If IsNumeric(rs(0).Value) Then
  284.         '[changed] 8/25/98     Set NewLine = LV.ListItems.Add(, , LTrim(RTrim(str(rs(0).Value))))
  285.         '[changed] 8/25/98 Else
  286.             '[changed] 8/30/98 Took off LTRIM to allow for sorting of numbers
  287.             Set NewLine = LV.ListItems.Add(, , pub_SQL2Text(m_Rs(0)))
  288.         '[changed] 8/25/98 End If
  289.         For intCount2 = 1 To m_Rs.Fields.Count - 1
  290.                 NewLine.SubItems(intCount2) = pub_SQL2Text(m_Rs(intCount2), True)
  291.         Next intCount2
  292.         m_Rs.MoveNext
  293.     Next intCount1
  294.     m_strCompareVal = ""  'reset value used to raise Change event
  295.       
  296.     LV.LabelWrap = False
  297.     On Error Resume Next '//  this nex LOC will trip if form isn't loaded
  298.                          '// (I.e. the control is requeried in the form_load event
  299.     If LV.Enabled = True Then LV.SetFocus
  300.     Exit Sub
  301. ERR_HANDLER:
  302.     ' Ignore Error 94 which indicates you passed a NULL value.
  303.     If Err = 94 Then
  304.         Resume Next
  305.     Else
  306.         Call Object_Err_Handler
  307.     End If
  308. End Sub
  309. Public Function SetColumnWidth(intIndex As Integer, ByVal New_Width As Integer)
  310. '    Sets the columnwidth of a specific listview column
  311. '    Parameters:  Column to change, New specified width
  312. '    Returns: Number of listitems in the control
  313. '    Based on Base Level 0
  314.     On Error GoTo ERR_HANDLER
  315.     If IsMissing(intIndex) Then intIndex = 1
  316.     LV.ColumnHeaders(intIndex + 1).Width = New_Width
  317.     Exit Function
  318. ERR_HANDLER:
  319.     Call Object_Err_Handler
  320. End Function
  321. Public Function Listcount() As Integer
  322. '    Gets the number of listitems in the control
  323. '    Parameters:  None
  324. '    Returns: Number of listitems in the control
  325.     Listcount = LV.ListItems.Count
  326. End Function
  327. '********* PRIVATE FUNCTIONS/SUBS *********************
  328. Private Function pub_SQL2Text(val As Variant, _
  329.                 Optional bolRtrim As Boolean = True) As Variant
  330. '    Converts recordset field into a string
  331. '    Parameters:  val = recordset field retrieved from SQL Database
  332. '    Returns: string
  333.     If IsNull(val) Then
  334.         pub_SQL2Text = ""
  335.     ElseIf IsDate(val) Then
  336.         pub_SQL2Text = CDate(val)
  337.     Else
  338.         If bolRtrim Then
  339.             pub_SQL2Text = RTrim(val)   'Take off trailing spaces
  340.         Else
  341.             pub_SQL2Text = CStr(val)
  342.         End If
  343.     End If
  344. End Function
  345. Private Function Object_Err_Handler()
  346.     Err.Raise Err.Number, , Err.Description
  347. End Function
  348.