ListView控件功能综合应用代码

'功能；检查ListView控件是否已初始化PublicFunctionListViewHead(ByRefListViewNameAsListView,ByRefListViewArray()AsVariant,ByValListViewTagNameAsString,ByValIsCheckBoxesAsBoolean)OnErrorGoToONERRORStaticInitializeAsLongStaticListViewTag()AsVariantDimiAsLongDimHeadAsBooleanReDimPreserveListViewTag(Initialize)Fori=0ToUBound(ListViewTag)IfListViewTagName=ListViewTag(i)ThenHead=TrueExitForElseHead=FalseEndIfNextIfHead=FalseThenCallMdlListView.ListViewInitialize(ListViewName,ListViewArray,IsCheckBoxes初始化控件ListViewTag(Initialize)=ListViewTagNameInitialize=Initialize+1EndIfExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox”错误代码："&Err.Number&"错误描述："&Err.Description,vbExclamation,'初始化”EraseListViewTagEndSelect'入口参数；ListViewl 是ListView控件对象.'入口参数；HeadArray() 是个二维变体数组'入口参数；IsCheckBoxes 是否要显示复选框'功能；ListView控件初始化为报表格式 可通用初始化ListView控件PrivateFunctionListViewInitialize(ByRefListView1AsListView,ByRefHeadArray()AsVariant,ByValIsCheckBoxesAsBoolean)OnErrorGoToONERRORDimitmXAsListItem '定义^■个ListItem对象DimclmXAsColumnHeader添加ColumnHeaders。列宽度等于控件的宽度DimiAsLongListView1.ListItems.Clear '刷新ListView控件ListView1.View=lvwReport '报表格式ListView1.Gridlines=True '确定在“报表”视图中ListView控件是否显示网格线ListView1.BorderStyle=ccFixedSingle '返回或设置对象的边框样式ListView1.FullRowSelect=True '是否选择整行SelectCaseIsCheckBoxesCaseIs=TrueListView1.CheckBoxes=True '是否显示复选框EndSelectFori=LBound(HeadArray)ToUBound(HeadArray)SetclmX=ListView1.ColumnHeaders.Add(,,HeadArray(i,0),HeadArray(i,1))NextSetitmX=NothingSetclmX=NothingEraseHeadArray清空内存空间ExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox”错误代码："&Err.Number&" 错误描述："&Err.Description,vbExclamation,'初始化”EndSelect'入口参数；ListViewl 是控件名称'入口参数；ArrayValue 是动态数组'功能；添加数据到ListView控件中PublicFunctionInisFile(ByRefListViewlAsListView,ByRefArrayValue()AsVariant)OnErrorGoToONERRORDimitmXAsListItem '定义^■个ListItem对象DimiAsLongFori=LBound(ArrayValue)ToUBound(ArrayValue)SelectCaseiCase0SetitmX=ListView1.ListItems.Add(,,ArrayValue(i))文件名称CaseElseSelectCaseTypeName(ArrayValue(i))Case"Date"itmX.SubItems(i)=Format(ArrayValue(i),"yyyy-m-d")'文件属性日期CaseElseitmX.SubItems(i)=ArrayValue(i)文件路径EndSelectSelectCaseArrayValue(i)Case"取消复制”，"创建目录”,"目录更改”itmX.ListSubItems.Item(i).ForeColor=vbRed'0xFF红色'vbBlueEndSelectEndSelectNextDoEvents转让控制权给系统SetitmX=NothingEraseArrayValue清空内存空间ExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCase9,380,383ResumeNextCaseElseMsgBox"错误代码："&Err.Number&"错误描述："&Err.Description,vbExclamation,"添加数据到ListView控件中”ResumeNext'入口参数；ListViewl 是ListView控件'入口参数；ArrayValue 是装载修改数据的数组'功能；修改ListView控件中的数据PublicFunctionUpdateListViewData(ByRefListViewlAsListView,ByValRow,ByRefArrayValue()AsVariant)OnErrorGoToONERRORDimitmXAsListItem '定义^■个ListItem对象DimiAsLongFori=LBound(ArrayValue)ToUBound(ArrayValue)SelectCaseiCase0SetitmX=ListView1.ListItems(Row)'获取指定行CaseElseSelectCaseTypeName(ArrayValue(i))Case"Date"itmX.SubItems(i)=Format(ArrayValue(i),"yyyy-m-d")'文件属性日期CaseElseitmX.SubItems(i)=ArrayValue(i)文件路径EndSelectSelectCaseArrayValue(i)Case"取消复制”，"创建目录”,"目录更改”itmX.ListSubItems.Item(i).ForeColor=vbRed'0xFF红色'vbBlue'更改指定列的字体颜色EndSelectEndSelectNextDoEvents转让控制权给系统SetitmX=NothingEraseArrayValue清空内存空间ExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox"错误代码："&Err.Number&" 错误描述："&Err.Description,vbExclamation,"修改ListView控件中的数据"ResumeNext

功能；在一个ListView控件查询另一个ListView控件的指定的字符串，并选中所当前行PrivateSubListView2_Click()OnErrorGoToONERRORDimstrFindMeAsStringIfListView2.ListItems.Count=0ThenExitSubstrFindMe=ListView2.ListItems(ListView2.SelectedItem.Index).Text’获取选定行的第一列的文本’FindItem方法返回找到的项目的引用，所以必须创建对象变量并将找到的项目设置给它。DimitmFoundAsListItem’FoundItem变量。SetitmFound=ListView1.FindItem(strFindMe,lvwText,,lvwPartial)’若未找到符合条件的ListItem则通知用户并退出。如果找到ListItem，则使用EnsureVisible方法滚动控件，并选定ListItemoIfitmFoundIsNothingThen’若没有匹配成功，则通知用户并退出。MsgBox"Nomatchfound"’滚动’滚动ListView以显示找到的ListItem。’选定ListItemo’将焦点返回给控件以查看选择。itmFound.EnsureVisibleitmFound.Selected=TrueListView1.SetFocusEndIfSetitmFound=NothingONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox"错误代码："&Err.Number&" 错误描述："&Err.Description,vbExclamation,App.ExeNameEndSelectEndIfEndSubListView控件的报图标功能应用代码'入口参数；ListViewl是ListView控件'入口参数；ImageListl是装载图片的ImageList控件，必须先装载好待用图片'功能；获取本机磁盘对象PublicFunctionGetDriveObject(ByRefListViewlAsListView,ByRefImageListlAsImageList)OnErrorGoToONERRORDimMyFsoAsObject '文件对象DimMyDriveAsDrive '磁盘对象集合DimitmXAsListItemSetMyFso=CreateObject("Scripting.FileSystemObject")ListView1.ListItems.Clear '刷新ListView控件ListView1.View=lvwIcon '图标格式ListView1.Icons=ImageList1 '初始化ImageList1图像控件ForEachMyDriveInMyFso.DrivesSelectCaseMyDrive.DriveTypeCase1'移动盘SetitmX=ListView1.ListItems.Add(,,UCase(MyDrive.DriveLetter)&":\",1)Case2'本地硬盘SetitmX=ListView1.ListItems.Add(,,UCase(MyDrive.DriveLetter)&":\",2)Case4'本地光驱SetitmX=ListView1.ListItems.Add(,,UCase(MyDrive.DriveLetter)&":\",3)EndSelectNextSetMyFso=Nothing:SetMyDrive=Nothing:SetitmX=NothingExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox"错误代码："&Err.Number&"错误描述："&Err.Description,vbExclamation,'磁盘对象EndSelectSetMyFso=Nothing:SetMyDrive=Nothing:SetitmX=NothingEndIfEndFunction'入口参数；ListViewl入口参数；'入口参数；ListViewl入口参数；TextArray'入口参数；ImageListl是一个一维数组是装载图片的ImageList控件，必须先装载好待用图片'功能；初始化ListView控件为图标格式PublicFunctionListView_ICO(ByRefListViewlAsListView,ByRefTextArray()AsVariant,ByRefImageListlAsImageList)OnErrorGoToONERRORDimForVAsLongDimitmXAsListItemListViewl.ListItems.ClearListViewl.ViewListViewl.ListItems.ClearListViewl.View=IvwIconListViewl.Icons=ImageListl'刷新ListView控件'图标格式'初始化ImageListl图像控件ForForV=LBound(TextArray)ToUBound(TextArray)SetitmX=ListView1.ListItems.Add(,,TextArray(ForV),1)NextSetitmX=NothingExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox”错误代码："&Err.Number&"错误描述："&Err.Description,vbExclamation,”图标格式EndSelectSetitmX=NothingEndIfEndFunction

是查询语句是控件对象全局连接数据对象是全局ADO是查询语句是控件对象全局连接数据对象是全局ADO对象，用于类模块查询用。'入口参数；ListViewl入口参数；ConnectObject入口参数；ADObject'功能；查询数据库数据并返回一个一维数组PublicFunctionSelectDATA(ByValSqlStringAsString,ByRefListView1AsListView,ByRefConnectObjectAsConnect,ByRefADObjectAsObject)AsBooleanOnErrorGoToONERRORDimColAsLongDimRecordsetAsADODB.RecordsetDimTempArray()AsVariantSelectCaseConnectObject.GetRecordset_Data(SqlString,Recordset,ADObject)Case0MsgBox”没有数据可提供查询！”,vbExclamation,App.EXENameSelectDATA=FalseCase1DoUntilRecordset.EOFForCol=0ToRecordset.Fields.Count-1ReDimPreserveTempArray(Col)TempArray(Col)=Recordset.Fields(Col).ValueDoEvents转让控制权给系统NextCallInisFile(ListView1,TempArray)添加数据到控件行中EraseTempArrayRecordset.MoveNextDoEvents'转让控制权给系统LoopRecordset.Close:SetRecordset=Nothing:SelectDATA=TrueCase2MsgBox”查询出错！"，vbExclamation,App.EXENameSelectDATA=FalseEndSelectExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox”错误代码："&Err.Number&"错误描述："&Err.Description,vbExclamation,"添加数据到ListView控件中”ResumeNext'入口参数；ListViewl 是控件对象'入口参数；Col 是指定要查找相同值的列入口参数；Col_Value 是要比较的值'功能；检查ListView控件中指定列的值是否重复输入PublicFunctionRemove_Repeat_Value(ByRefListViewlAsListView,ByValColAsLong,ByValCol_ValueAsVariant)AsBooleanOnErrorGoToONERRORDimRAsLongDimTempAsStringDimCAsLongIfListView1.ListItems.Count>0ThenForR=1ToListView1.ListItems.CountIfCol=1Then'如果是指定第一列的值Temp=ListView1.ListItems(R).Text '获取当前行的第一列的文本ElseTemp=ListView1.ListItems(R).SubItems(Col)'获取当前行的指定的列的文本值EndIfDoEvents'转移控制权'执行比较IfStrComp(Trim(Temp),Col_Value,vbBinaryCompare)=0Then '找到相同值，就退出函数MsgBoxCol_Value&”已经被添加到待禁止运行界面中，不需要重复添加！",vbExclamation,”提示”Remove_Repeat_Value=TrueExitFunctionEndIfNextRemove_Repeat_Value=False循环完成如果没有找到相同值则返回假ElseRemove_Repeat_Value=FalseEndIfExitFunctionONERROR:IfErr.Number<>0ThenSelectCaseErr.NumberCaseElseMsgBox"错误代码："&Err.Number&" 错误描述："&Err.Description,vbExclamation,'指定列的值是否重复输入"ResumeNext

'入口参数；ListView1'入口参数；Col是控件对象是指定要查找相同值的列是要比较的值'入口参数；Col_V