⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mdllistview.vb

📁 <Visual Basic 数据库开发实例精粹(第二版)>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术
💻 VB
📖 第 1 页 / 共 2 页
字号:
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 + -