ListView控件功能综合应用代码.doc

ListView控件的报表功能应用代码功能；检查ListView控件是否已初始化Public Function ListViewHead(ByRef ListViewName As ListView, ByRef ListViewArray() As Variant, ByVal ListViewTagName As String, ByVal IsCheckBoxes As Boolean)On Error GoTo ONERRORStatic Initialize As LongStatic ListViewTag() As VariantDim i As LongDim Head As Boolean ReDim Preserve ListViewTag(Initialize) For i = 0 To UBound(ListViewTag) If ListViewTagName = ListViewTag(i) Then Head = True Exit For Else Head = False End If Next If Head = False Then Call MdlListView.ListViewInitialize(ListViewName, ListViewArray, IsCheckBoxes) 初始化控件 ListViewTag(Initialize) = ListViewTagName Initialize = Initialize + 1 End IfExit FunctionONERROR: If Err.Number 0 Then Select Case Err.Number Case Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 初始化 Erase ListViewTag End Select End IfEnd Function入口参数；ListView1 是ListView控件对象.入口参数；HeadArray() 是个二维变体数组入口参数；IsCheckBoxes 是否要显示复选框功能；ListView 控件初始化为报表格式 可通用初始化ListView控件Private Function ListViewInitialize(ByRef ListView1 As ListView, ByRef HeadArray() As Variant, ByVal IsCheckBoxes As Boolean)On Error GoTo ONERRORDim itmX As ListItem 定义一个ListItem对象Dim clmX As ColumnHeader 添加 ColumnHeaders。列宽度等于控件的宽度Dim i As Long ListView1.ListItems.Clear 刷新ListView控件 ListView1.View = lvwReport 报表格式 ListView1.Gridlines = True 确定在“报表”视图中ListView控件是否显示网格线 ListView1.BorderStyle = ccFixedSingle 返回或设置对象的边框样式 ListView1.FullRowSelect = True 是否选择整行 Select Case IsCheckBoxes Case Is = True ListView1.CheckBoxes = True 是否显示复选框 End Select For i = LBound(HeadArray) To UBound(HeadArray) Set clmX = ListView1.ColumnHeaders.Add(, , HeadArray(i, 0), HeadArray(i, 1) Next Set itmX = Nothing Set clmX = Nothing Erase HeadArray 清空内存空间 Exit FunctionONERROR: If Err.Number 0 Then Select Case Err.Number Case Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 初始化 End Select End IfEnd Function入口参数；ListView1 是控件名称入口参数；ArrayValue 是动态数组功能；添加数据到ListView控件中Public Function InisFile(ByRef ListView1 As ListView, ByRef ArrayValue() As Variant)On Error GoTo ONERRORDim itmX As ListItem 定义一个ListItem对象Dim i As Long For i = LBound(ArrayValue) To UBound(ArrayValue) Select Case i Case 0 Set itmX = ListView1.ListItems.Add(, , ArrayValue(i) 文件名称 Case Else Select Case TypeName(ArrayValue(i) Case Date itmX.SubItems(i) = Format(ArrayValue(i), yyyy-m-d) 文件属性日期 Case Else itmX.SubItems(i) = ArrayValue(i) 文件路径 End Select Select Case ArrayValue(i) Case 取消复制, 创建目录, 目录更改 itmX.ListSubItems.Item(i).ForeColor = vbRed 0xFF 红色 vbBlue End Select End Select Next DoEvents 转让控制权给系统 Set itmX = Nothing Erase ArrayValue 清空内存空间Exit FunctionONERROR:If Err.Number 0 ThenSelect Case Err.NumberCase 9, 380, 383 Resume NextCase Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 添加数据到ListView控件中 Resume NextEnd SelectEnd IfEnd Function入口参数；ListView1 是ListView控件入口参数；ArrayValue 是装载修改数据的数组功能；修改ListView控件中的数据Public Function UpdateListViewData(ByRef ListView1 As ListView, ByVal Row, ByRef ArrayValue() As Variant)On Error GoTo ONERRORDim itmX As ListItem 定义一个ListItem对象Dim i As Long For i = LBound(ArrayValue) To UBound(ArrayValue) Select Case i Case 0 Set itmX = ListView1.ListItems(Row) 获取指定行 Case Else Select Case TypeName(ArrayValue(i) Case Date itmX.SubItems(i) = Format(ArrayValue(i), yyyy-m-d) 文件属性日期 Case Else itmX.SubItems(i) = ArrayValue(i) 文件路径 End Select Select Case ArrayValue(i) Case 取消复制, 创建目录, 目录更改 itmX.ListSubItems.Item(i).ForeColor = vbRed 0xFF 红色 vbBlue 更改指定列的字体颜色 End Select End Select Next DoEvents 转让控制权给系统 Set itmX = Nothing Erase ArrayValue 清空内存空间Exit FunctionONERROR:If Err.Number 0 ThenSelect Case Err.NumberCase Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 修改ListView控件中的数据 Resume NextEnd SelectEnd IfEnd FunctionListView控件的报图标功能应用代码入口参数；ListView1 是ListView控件入口参数；ImageList1 是装载图片的ImageList控件，必须先装载好待用图片功能；获取本机磁盘对象Public Function GetDriveObject(ByRef ListView1 As ListView, ByRef ImageList1 As ImageList)On Error GoTo ONERRORDim MyFso As Object 文件对象Dim MyDrive As Drive 磁盘对象集合Dim itmX As ListItem Set MyFso = CreateObject(Scripting.FileSystemObject) ListView1.ListItems.Clear 刷新ListView控件 ListView1.View = lvwIcon 图标格式 ListView1.Icons = ImageList1 初始化ImageList1图像控件 For Each MyDrive In MyFso.Drives Select Case MyDrive.DriveType Case 1 移动盘 Set itmX = ListView1.ListItems.Add(, , UCase(MyDrive.DriveLetter) & :, 1) Case 2 本地硬盘 Set itmX = ListView1.ListItems.Add(, , UCase(MyDrive.DriveLetter) & :, 2) Case 4 本地光驱 Set itmX = ListView1.ListItems.Add(, , UCase(MyDrive.DriveLetter) & :, 3) End Select Next Set MyFso = Nothing:Set MyDrive = Nothing:Set itmX = NothingExit FunctionONERROR:If Err.Number 0 Then Select Case Err.Number Case Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 磁盘对象 End Select Set MyFso = Nothing:Set MyDrive = Nothing:Set itmX = NothingEnd IfEnd Function入口参数；ListView1 是ListView控件对象入口参数；TextArray是一个一维数组入口参数；ImageList1是装载图片的ImageList控件，必须先装载好待用图片功能；初始化 ListView 控件为图标格式Public Function ListView_ICO(ByRef ListView1 As ListView, ByRef TextArray() As Variant, ByRef ImageList1 As ImageList)On Error GoTo ONERRORDim ForV As LongDim itmX As ListItem ListView1.ListItems.Clear 刷新ListView控件 ListView1.View = lvwIcon 图标格式 ListView1.Icons = ImageList1 初始化ImageList1图像控件 For ForV = LBound(TextArray) To UBound(TextArray) Set itmX = ListView1.ListItems.Add(, , TextArray(ForV), 1) Next Set itmX = Nothing Exit FunctionONERROR:If Err.Number 0 Then Select Case Err.Number Case Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 图标格式 End Select Set itmX = NothingEnd IfEnd Function入口参数；SqlString 是查询语句入口参数；ListView1 是控件对象入口参数；ConnectObject 全局连接数据对象入口参数；ADObject 是全局ADO对象，用于类模块查询用。功能；查询数据库数据并返回一个一维数组Public Function SelectDATA(ByVal SqlString As String, ByRef ListView1 As ListView, ByRef ConnectObject As Connect, ByRef ADObject As Object) As BooleanOn Error GoTo ONERRORDim Col As LongDim Recordset As ADODB.RecordsetDim TempArray() As Variant Select Case ConnectObject.GetRecordset_Data(SqlString, Recordset, ADObject) Case 0 MsgBo