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

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

《ListView控件功能综合应用代码.docx》由会员分享，可在线阅读，更多相关《ListView控件功能综合应用代码.docx（13页珍藏版）》请在冰豆网上搜索。

ListView控件功能综合应用代码

ListView控件的报表功能应用代码

'功能；检查ListView控件是否已初始化

PublicFunctionListViewHead（ByRefListViewNameAsListView,ByRefListViewArray（）AsVariant,ByValListViewTagNameAsString,ByValIsCheckBoxesAsBoolean）

OnErrorGoToONERROR

StaticInitializeAsLong

StaticListViewTag（）AsVariant

DimiAsLong

DimHeadAsBoolean

ReDimPreserveListViewTag（Initialize）

Fori=0ToUBound（ListViewTag）

IfListViewTagName=ListViewTag（i）Then

Head=True

ExitFor

Else

Head=False

EndIf

Next

IfHead=FalseThen

CallMdlListView.ListViewInitialize（ListViewName,ListViewArray,IsCheckBoxes）'初始化控件

ListViewTag（Initialize）=ListViewTagName

Initialize=Initialize+1

EndIf

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"初始化"

EraseListViewTag

EndSelect

EndIf

EndFunction

'入口参数；ListView1是ListView控件对象.

'入口参数；HeadArray（）是个二维变体数组

'入口参数；IsCheckBoxes是否要显示复选框

'功能；ListView控件初始化为报表格式可通用初始化ListView控件

PrivateFunctionListViewInitialize（ByRefListView1AsListView,ByRefHeadArray（）AsVariant,ByValIsCheckBoxesAsBoolean）

OnErrorGoToONERROR

DimitmXAsListItem'定义一个ListItem对象

DimclmXAsColumnHeader'添加ColumnHeaders。

列宽度等于控件的宽度

DimiAsLong

ListView1.ListItems.Clear'刷新ListView控件

ListView1.View=lvwReport'报表格式

ListView1.Gridlines=True'确定在“报表”视图中ListView控件是否显示网格线

ListView1.BorderStyle=ccFixedSingle'返回或设置对象的边框样式

ListView1.FullRowSelect=True'是否选择整行

SelectCaseIsCheckBoxes

CaseIs=True

ListView1.CheckBoxes=True'是否显示复选框

EndSelect

Fori=LBound（HeadArray）ToUBound（HeadArray）

SetclmX=ListView1.ColumnHeaders.Add（,,HeadArray（i,0）,HeadArray（i,1））

Next

SetitmX=Nothing

SetclmX=Nothing

EraseHeadArray'清空内存空间

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"初始化"

EndSelect

EndIf

EndFunction

'

'入口参数；ListView1是控件名称

'入口参数；ArrayValue是动态数组

'功能；添加数据到ListView控件中

PublicFunctionInisFile（ByRefListView1AsListView,ByRefArrayValue（）AsVariant）

OnErrorGoToONERROR

DimitmXAsListItem'定义一个ListItem对象

DimiAsLong

Fori=LBound（ArrayValue）ToUBound（ArrayValue）

SelectCasei

Case0

SetitmX=ListView1.ListItems.Add（,,ArrayValue（i））'文件名称

CaseElse

SelectCaseTypeName（ArrayValue（i））

Case"Date"

itmX.SubItems（i）=Format（ArrayValue（i）,"yyyy-m-d"）'文件属性日期

CaseElse

itmX.SubItems（i）=ArrayValue（i）'文件路径

EndSelect

SelectCaseArrayValue（i）

Case"取消复制","创建目录","目录更改"

itmX.ListSubItems.Item（i）.ForeColor=vbRed'0xFF红色'vbBlue

EndSelect

EndSelect

Next

DoEvents'转让控制权给系统

SetitmX=Nothing

EraseArrayValue'清空内存空间

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

Case9,380,383

ResumeNext

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"添加数据到ListView控件中"

ResumeNext

EndSelect

EndIf

EndFunction

'入口参数；ListView1是ListView控件

'入口参数；ArrayValue是装载修改数据的数组

'功能；修改ListView控件中的数据

PublicFunctionUpdateListViewData（ByRefListView1AsListView,ByValRow,ByRefArrayValue（）AsVariant）

OnErrorGoToONERROR

DimitmXAsListItem'定义一个ListItem对象

DimiAsLong

Fori=LBound（ArrayValue）ToUBound（ArrayValue）

SelectCasei

Case0

SetitmX=ListView1.ListItems（Row）'获取指定行

CaseElse

SelectCaseTypeName（ArrayValue（i））

Case"Date"

itmX.SubItems（i）=Format（ArrayValue（i）,"yyyy-m-d"）'文件属性日期

CaseElse

itmX.SubItems（i）=ArrayValue（i）'文件路径

EndSelect

SelectCaseArrayValue（i）

Case"取消复制","创建目录","目录更改"

itmX.ListSubItems.Item（i）.ForeColor=vbRed'0xFF红色'vbBlue'更改指定列的字体颜色

EndSelect

EndSelect

Next

DoEvents'转让控制权给系统

SetitmX=Nothing

EraseArrayValue'清空内存空间

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"修改ListView控件中的数据"

ResumeNext

EndSelect

EndIf

EndFunction

功能；在一个ListView控件查询另一个ListView控件的指定的字符串，并选中所当前行

PrivateSubListView2_Click（）

OnErrorGoToONERROR

DimstrFindMeAsString

IfListView2.ListItems.Count=0ThenExitSub

strFindMe=ListView2.ListItems（ListView2.SelectedItem.Index）.Text’获取选定行的第一列的文本

’FindItem方法返回找到的项目的引用，所以必须创建对象变量并将找到的项目设置给它。

DimitmFoundAsListItem’FoundItem变量。

SetitmFound=ListView1.FindItem（strFindMe,lvwText,,lvwPartial）

’若未找到符合条件的ListItem则通知用户并退出。

如果找到ListItem，则使用EnsureVisible方法滚动控件，并选定ListItem。

IfitmFoundIsNothingThen’若没有匹配成功，则通知用户并退出。

MsgBox"Nomatchfound"

Else

itmFound.EnsureVisible’滚动ListView以显示找到的ListItem。

itmFound.Selected=True’选定ListItem。

ListView1.SetFocus’将焦点返回给控件以查看选择。

EndIf

SetitmFound=Nothing

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,App.ExeName

EndSelect

EndIf

EndSub

ListView控件的报图标功能应用代码

'入口参数；ListView1是ListView控件

'入口参数；ImageList1是装载图片的ImageList控件，必须先装载好待用图片

'功能；获取本机磁盘对象

PublicFunctionGetDriveObject（ByRefListView1AsListView,ByRefImageList1AsImageList）

OnErrorGoToONERROR

DimMyFsoAsObject'文件对象

DimMyDriveAsDrive'磁盘对象集合

DimitmXAsListItem

SetMyFso=CreateObject（"Scripting.FileSystemObject"）

ListView1.ListItems.Clear'刷新ListView控件

ListView1.View=lvwIcon'图标格式

ListView1.Icons=ImageList1'初始化ImageList1图像控件

ForEachMyDriveInMyFso.Drives

SelectCaseMyDrive.DriveType

Case1'移动盘

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）

EndSelect

Next

SetMyFso=Nothing:

SetMyDrive=Nothing:

SetitmX=Nothing

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"磁盘对象"

EndSelect

SetMyFso=Nothing:

SetMyDrive=Nothing:

SetitmX=Nothing

EndIf

EndFunction

'入口参数；ListView1是ListView控件对象

入口参数；TextArray是一个一维数组

'入口参数；ImageList1是装载图片的ImageList控件，必须先装载好待用图片

'功能；初始化ListView控件为图标格式

PublicFunctionListView_ICO（ByRefListView1AsListView,ByRefTextArray（）AsVariant,ByRefImageList1AsImageList）

OnErrorGoToONERROR

DimForVAsLong

DimitmXAsListItem

ListView1.ListItems.Clear'刷新ListView控件

ListView1.View=lvwIcon'图标格式

ListView1.Icons=ImageList1'初始化ImageList1图像控件

ForForV=LBound（TextArray）ToUBound（TextArray）

SetitmX=ListView1.ListItems.Add（,,TextArray（ForV）,1）

Next

SetitmX=Nothing

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"图标格式"

EndSelect

SetitmX=Nothing

EndIf

EndFunction

'入口参数；SqlString是查询语句

'入口参数；ListView1是控件对象

'入口参数；ConnectObject全局连接数据对象

'入口参数；ADObject是全局ADO对象，用于类模块查询用。

'功能；查询数据库数据并返回一个一维数组

PublicFunctionSelectDATA（ByValSqlStringAsString,ByRefListView1AsListView,ByRefConnectObjectAsConnect,ByRefADObjectAsObject）AsBoolean

OnErrorGoToONERROR

DimColAsLong

DimRecordsetAsADODB.Recordset

DimTempArray（）AsVariant

SelectCaseConnectObject.GetRecordset_Data（SqlString,Recordset,ADObject）

Case0

MsgBox"没有数据可提供查询！

",vbExclamation,App.EXEName

SelectDATA=False

Case1

DoUntilRecordset.EOF

ForCol=0ToRecordset.Fields.Count-1

ReDimPreserveTempArray（Col）

TempArray（Col）=Recordset.Fields（Col）.Value

DoEvents'转让控制权给系统

Next

CallInisFile（ListView1,TempArray）'添加数据到控件行中

EraseTempArray

Recordset.MoveNext

DoEvents'转让控制权给系统

Loop

Recordset.Close:

SetRecordset=Nothing:

SelectDATA=True

Case2

MsgBox"查询出错！

",vbExclamation,App.EXEName

SelectDATA=False

EndSelect

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"添加数据到ListView控件中"

ResumeNext

EndSelect

EndIf

EndFunction

'入口参数；ListView1是控件对象

'入口参数；Col是指定要查找相同值的列

'入口参数；Col_Value是要比较的值

'功能；检查ListView控件中指定列的值是否重复输入

PublicFunctionRemove_Repeat_Value（ByRefListView1AsListView,ByValColAsLong,ByValCol_ValueAsVariant）AsBoolean

OnErrorGoToONERROR

DimRAsLong

DimTempAsString

DimCAsLong

IfListView1.ListItems.Count>0Then

ForR=1ToListView1.ListItems.Count

IfCol=1Then'如果是指定第一列的值

Temp=ListView1.ListItems（R）.Text'获取当前行的第一列的文本

Else

Temp=ListView1.ListItems（R）.SubItems（Col）'获取当前行的指定的列的文本值

EndIf

DoEvents'转移控制权

'执行比较

IfStrComp（Trim（Temp）,Col_Value,vbBinaryCompare）=0Then'找到相同值，就退出函数

MsgBoxCol_Value&"已经被添加到待禁止运行界面中，不需要重复添加！

",vbExclamation,"提示"

Remove_Repeat_Value=True

ExitFunction

EndIf

Next

Remove_Repeat_Value=False'循环完成如果没有找到相同值则返回假

Else

Remove_Repeat_Value=False

EndIf

ExitFunction

ONERROR:

IfErr.Number<>0Then

SelectCaseErr.Number

CaseElse

MsgBox"错误代码：

"&Err.Number&"错误描述：

"&Err.Description,vbExclamation,"指定列的值是否重复输入"

ResumeNext

EndSelect

EndIf

EndFunction

'入口参数；ListView1是控件对象

'入口参数；Col是指定要查找相同值的列

'入口参数；Col_Value是要比较的值

'功能；检查ListView控件中指定列的值是否重复输入

PublicFunctionRemove_Repeat_Value（ByRefListView1AsListView,ByValColAsLong,ByValCol_ValueAsVariant）AsBoolean

OnErrorGoToONERROR

'不要删除下面所有注释的行。

'DimstrFindMeAsString

'

'strFindMe=ListView2.ListItems（ListView2.SelectedItem.Index）.Text'获取选定行的第一列的文本

'FindItem方法返回找到的项目的引用，所以必须创建对象变量并将找到的项目设置给它。

DimitmFoundAsListItem'“FoundItem变量”

SetitmFound=ListView1.FindItem（Col_Value,lvwText,,lvwPartial）