📄 mdllistview.vb
字号:
Module mdlListView
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#Region "Client + ListView相关函数"
'按照“客户”初始化ListView的显示样式
Public Sub InitClientListView(ByRef lsv As TreeListView)
With lsv
.View = View.Details
.Columns.Clear()
'加入四个列首
.Columns.Add("姓名", 120, HorizontalAlignment.Left)
.Columns.Add("客户类别", 80, HorizontalAlignment.Left)
.Columns.Add("性别", 40, HorizontalAlignment.Left)
.Columns.Add("手机", 120, HorizontalAlignment.Left)
.Columns.Add("E-mail", 150, HorizontalAlignment.Left)
.Columns.Add("生日提醒", 80, HorizontalAlignment.Left)
End With
End Sub
#Region "V2.1新增代码,增加分组显示功能,需要TreeListView控件"
'本函数采用另一种分组方式,逐个将Type列出,
'在列出Type的同时,加入其下属客户
Public Function ClientsToListView(ByRef tlv As TreeListView, _
ByVal iTypeId As Integer, _
ByVal bShowInGroup As Boolean, _
ByVal bResverse As Boolean, _
ByVal bShowRoot As Boolean, _
Optional ByVal szName As String = "", _
Optional ByVal szTel As String = "", _
Optional ByVal szResultTitle As String = "") As Integer
Dim ErrMsg As String
Dim typeObj As New clientMgrBusiness.ClientType
Dim dmType As New clientMgrBusiness.ClientTypeDataModel
Dim iClientCount As Integer = 0
If szResultTitle = "" Then
If iTypeId = 0 Then
dmType.TypeName = "所有客户"
Else
ErrMsg = typeObj.GetTypeInfo(dmType, iTypeId)
End If
Else
dmType.TypeName = szResultTitle
End If
Dim root As New TreeListViewItem(dmType.TypeName)
root.Tag = iTypeId
root.ImageIndex = 2
'如果列表还未初始化,则初始化之
If tlv.Columns.Count = 0 Then
InitClientListView(tlv)
End If
tlv.Items.Clear()
tlv.Items.Add(root)
iClientCount = LoadSubClients(root, bShowInGroup, bResverse, szName, szTel)
tlv.Items.Clear()
Dim node As TreeListViewItem
If bShowRoot Then
tlv.Items.Add(root)
Else
For Each node In root.Items
tlv.Items.Add(node)
Next
End If
tlv.ExpandAll()
Return iClientCount
End Function
'调用递归,显示树型的客户类型结构
Private Function LoadSubClients(ByRef node As TreeListViewItem, _
ByVal bShowInGroup As Boolean, _
ByVal bResverse As Boolean, _
Optional ByVal szName As String = "", _
Optional ByVal szTel As String = "") As Integer
Dim typeObj As New clientMgrBusiness.ClientType
Dim dmType As clientMgrBusiness.ClientTypeDataModel
Dim clientObj As New clientMgrBusiness.Client
Dim dmClient As clientMgrBusiness.ClientDataModel
Dim i, j As Integer
Dim ErrMsg As String
Dim AryType As New ArrayList
Dim AryClient As New ArrayList
Dim iClientCount As Integer = 0
Dim iTotalClientCount As Integer = 0
'1) 首选加载本类型下的直属客户
AryClient.Clear()
ErrMsg = clientObj.Search(AryClient, node.Tag, szName, szTel)
For j = 0 To AryClient.Count - 1
dmClient = AryClient(j)
AddClientToLvw(dmClient, node, False)
Next j
iTotalClientCount = AryClient.Count
'2) 找到本级下的所有客户类型
If bResverse Then
AryType.Clear()
ErrMsg = typeObj.GetAllDirectSubTypes(AryType, node.Tag)
Dim subNode As TreeListViewItem
For i = 0 To AryType.Count - 1
dmType = AryType(i)
'构造结点数据
subNode = New TreeListViewItem(dmType.TypeName)
subNode.ImageIndex = 2
subNode.Tag = dmType.ID
'2.5) 如果本Type既不包含Client,也不包含type,则不显示之
If typeObj.IsExistChild(dmType.ID) Or _
typeObj.IsExistClient(dmType.ID) Then
'递归加载下级客户类型.....
node.Items.Add(subNode)
iClientCount = LoadSubClients(subNode, bShowInGroup, bResverse, szName, szTel)
iTotalClientCount += iClientCount
node.Items.Remove(subNode)
Dim nd As TreeListViewItem
If bShowInGroup And iClientCount > 0 Then
node.Items.Add(subNode)
Else
For Each nd In subNode.Items
node.Items.Add(nd)
Next
End If
End If
Next i
End If
Return iTotalClientCount
End Function
'用dmClient内的数据更新列表中当前选种结点
Public Sub UpdateClientToLvw(ByVal dmClient As clientMgrBusiness.ClientDataModel, _
ByRef tlv As TreeListView)
'第三个参数如果是TRUE,则说明是更新当前已存在的某个列表项,否则是新加一个列表项
Dim Item As TreeListViewItem
If tlv.SelectedItems.Count = 0 Then
Return
End If
Item = tlv.SelectedItems(0)
If tlv.SelectedItems.Count > 0 Then
AddClientToLvw(dmClient, Item, True)
End If
End Sub
'将单个客户加入列表,或在列表中更新
'特意将该函数单独做出来,而没有将本函数中的代码完全在ClientsToListView函数中实现
'Why?
'因为在设计该功能时,你还应考虑到在以后的编程过程中,很可能要用到
'将某个单独的“客户”对象加入列表框(比如新增加了一个客户)。
Public Sub AddClientToLvw(ByVal dmClient As clientMgrBusiness.ClientDataModel, _
ByRef node As TreeListViewItem, ByVal IsOverWrite As Boolean)
'第三个参数如果是TRUE,则说明是更新当前已存在的某个列表项,否则是新加一个列表项
Dim Itm As TreeListViewItem
Dim tlv As TreeListView
tlv = node.TreeListView
If tlv Is Nothing Then
Return
End If
'根据性别不同来选取不同的头像
Dim img As Integer
img = IIf(dmClient.Sex = clientMgrBusiness.dmSex.Male, 0, 1)
'如果是更新(即覆盖),则使用当前选种的元素
If IsOverWrite And tlv.SelectedItems.Count > 0 Then
Itm = tlv.SelectedItems(0)
Else
Itm = New TreeListViewItem(dmClient.Name)
node.Items.Add(Itm)
Itm.SubItems.AddRange(New String() {"", "", "", "", ""})
End If
With dmClient '这里要与InitClientListview相对应
Itm.ImageIndex = img
Itm.SubItems(0).Text = .Name
Itm.SubItems(1).Text = (.TypeName)
Itm.SubItems(2).Text = (IIf(.Sex = clientMgrBusiness.dmSex.Male, "男", "女"))
Itm.SubItems(3).Text = (.Mobile)
Itm.SubItems(4).Text = (.Email)
Itm.SubItems(5).Text = (IIf(.BirthdayWarn, "启用", "未启用"))
Itm.Tag = .ID
End With
End Sub
#End Region
#Region "以不分组形式加入列表中,支持ListView和TreeListView"
'将指定客户类型下的所有客户显示到ListView中
Public Sub ClientsToListView(ByVal iTypeId As Integer, _
ByRef lsv As TreeListView)
Dim ErrMsg As String
Dim Ary As New ArrayList
Dim clientObj As New clientMgrBusiness.Client
ErrMsg = clientObj.Search(Ary, iTypeId)
ClientsToListView(Ary, lsv)
End Sub
'将客户集合显示到ListView中
Public Sub ClientsToListView(ByVal Ary As ArrayList, _
ByRef tlv As TreeListView)
Dim i As Integer
Dim ErrMsg As String = ""
'如果列表还未初始化,则初始化之
If tlv.Columns.Count = 0 Then
InitClientListView(tlv)
End If
tlv.Items.Clear() '清除当前的列表内容
Dim root As New TreeListViewItem
Dim dmClient As clientMgrBusiness.ClientDataModel
For i = 0 To Ary.Count - 1
'将每个“客户”都加入到该列表中,调用了单独的函数,没有全部做到这
'个函数中,为什么呢?参看AddClientToLvw函数
dmClient = Ary(i)
AddClientToLvw(dmClient, root, False)
Next i
'将root下的item复制到TreeListView中
Dim Item As TreeListViewItem
For Each Item In root.Items
tlv.Items.Add(Item)
Next
Return
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -