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

1、ListView控件功能综合应用代码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 A

2、s 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) 初始化控件 List

3、ViewTag(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控件对象.入口参数

4、；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 添加 Colum

5、nHeaders。列宽度等于控件的宽度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.Ch

6、eckBoxes = 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

7、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对

8、象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) 文

9、件路径 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 Next

10、Case 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() A

11、s 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) 文件

12、属性日期 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.Num

13、ber 0 ThenSelect Case Err.NumberCase Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 修改ListView控件中的数据 Resume NextEnd SelectEnd IfEnd Function功能；在一个ListView控件查询另一个ListView控件的指定的字符串，并选中所当前行Private Sub ListView2_Click()On Error GoTo ONERRORDim strFindMe As String If ListView2.L

14、istItems.Count = 0 Then Exit Sub strFindMe = ListView2.ListItems(ListView2.SelectedItem.Index).Text 获取选定行的第一列的文本 FindItem 方法返回找到的项目的引用，所以必须创建对象变量并将找到的项目设置给它。 Dim itmFound As ListItem FoundItem 变量。 Set itmFound = ListView1.FindItem(strFindMe, lvwText, , lvwPartial) 若未找到符合条件的 ListItem 则通知用户并退出。如果找到 Li

15、stItem，则使用 EnsureVisible 方法滚动控件，并选定 ListItem。 If itmFound Is Nothing Then 若没有匹配成功，则通知用户并退出。 MsgBox No match found Else itmFound.EnsureVisible 滚动 ListView 以显示找到的 ListItem。 itmFound.Selected = True 选定ListItem。 ListView1.SetFocus 将焦点返回给控件以查看选择。 End If Set itmFound = NothingONERROR:If Err.Number 0 Then

16、Select Case Err.Number Case Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, App.ExeName End SelectEnd IfEnd SubListView控件的报图标功能应用代码入口参数；ListView1 是ListView控件入口参数；ImageList1 是装载图片的ImageList控件，必须先装载好待用图片功能；获取本机磁盘对象Public Function GetDriveObject(ByRef ListView1 As ListView, ByR

17、ef 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 My

18、Drive 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)

19、 & :, 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 = Not

20、hingEnd 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 i

21、tmX 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

22、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 Select

23、DATA(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)

24、Case 0 MsgBox 没有数据可提供查询！, vbExclamation, App.EXEName SelectDATA = False Case 1 Do Until Recordset.EOF For Col = 0 To Recordset.Fields.Count - 1 ReDim Preserve TempArray(Col) TempArray(Col) = Recordset.Fields(Col).Value DoEvents 转让控制权给系统 Next Call InisFile(ListView1, TempArray) 添加数据到控件行中 Erase TempAr

25、ray Recordset.MoveNext DoEvents 转让控制权给系统 Loop Recordset.Close: Set Recordset = Nothing: SelectDATA = True Case 2 MsgBox 查询出错！, vbExclamation, App.EXEName SelectDATA = False End SelectExit FunctionONERROR:If Err.Number 0 ThenSelect Case Err.NumberCase Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Desc

26、ription, vbExclamation, 添加数据到ListView控件中 Resume NextEnd SelectEnd IfEnd Function入口参数；ListView1 是控件对象入口参数；Col 是指定要查找相同值的列入口参数；Col_Value 是要比较的值功能；检查 ListView 控件中指定列的值是否重复输入Public Function Remove_Repeat_Value(ByRef ListView1 As ListView, ByVal Col As Long, ByVal Col_Value As Variant) As BooleanOn Error

27、 GoTo ONERRORDim R As LongDim Temp As StringDim C As Long If ListView1.ListItems.Count 0 Then For R = 1 To ListView1.ListItems.Count If Col = 1 Then 如果是指定第一列的值 Temp = ListView1.ListItems(R).Text 获取当前行的第一列的文本 Else Temp = ListView1.ListItems(R).SubItems(Col) 获取当前行的指定的列的文本值 End If DoEvents 转移控制权 执行比较 I

28、f StrComp(Trim(Temp), Col_Value, vbBinaryCompare) = 0 Then 找到相同值，就退出函数 MsgBox Col_Value & 已经被添加到待禁止运行界面中，不需要重复添加！, vbExclamation, 提示 Remove_Repeat_Value = True Exit Function End If Next Remove_Repeat_Value = False 循环完成 如果没有找到相同值则返回假 Else Remove_Repeat_Value = False End If Exit FunctionONERROR:If Err

29、.Number 0 ThenSelect Case Err.NumberCase Else MsgBox 错误代码： & Err.Number & 错误描述： & Err.Description, vbExclamation, 指定列的值是否重复输入 Resume NextEnd SelectEnd IfEnd Function入口参数；ListView1 是控件对象入口参数；Col 是指定要查找相同值的列入口参数；Col_Value 是要比较的值功能；检查 ListView 控件中指定列的值是否重复输入Public Function Remove_Repeat_Value(ByRef Lis

30、tView1 As ListView, ByVal Col As Long, ByVal Col_Value As Variant) As BooleanOn Error GoTo ONERROR不要删除下面所有注释的行。 Dim strFindMe As String strFindMe = ListView2.ListItems(ListView2.SelectedItem.Index).Text 获取选定行的第一列的文本 FindItem 方法返回找到的项目的引用，所以必须创建对象变量并将找到的项目设置给它。 Dim itmFound As ListItem “FoundItem 变量” Set itmFound = ListView1.FindItem(Col_Value, lvwText, , lvwPartial)