ListView控件功能综合应用代码
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
ListView控件的报表功能应用代码
'功能；检查ListView控件是否已初始化
Public Function ListViewHead(ByRef ListViewName As ListView, ByRef ListViewArray() As Variant, ByVal ListViewTagName As String, ByVal IsCheckBoxes As Boolean)
On Error GoTo ONERROR
Static Initialize As Long
Static ListViewTag() As Variant
Dim i As Long
Dim 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 If
Exit Function
ONERROR:
If Err.Number <> 0 Then
Select Case Err.Number
Case Else
MsgBox "错误代码：" & Err.Number & " 错误描述：" & Err.Description, vbExclamation, "初始化"
Erase ListViewTag
End Select
End If
End 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 ONERROR
Dim 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 Function
ONERROR:
If Err.Number <> 0 Then
Select Case Err.Number
Case Else
MsgBox "错误代码：" & Err.Number & " 错误描述：" & Err.Description, vbExclamation, "初始化"
End Select
End If
End Function
'
'入口参数；ListView1 是控件名称
'入口参数；ArrayValue 是动态数组
'功能；添加数据到ListView控件中
Public Function InisFile(ByRef ListView1 As ListView, ByRef ArrayValue() As Variant)
On Error GoTo ONERROR
Dim 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 Function
ONERROR:
If Err.Number <> 0 Then
Select Case Err.Number
Case 9, 380, 383
Resume Next
Case Else
MsgBox "错误代码：" & Err.Number & " 错误描述：" & Err.Description, vbExclamation, "添加数据到ListView控件中"
Resume Next
End Select
End If
End Function