mdllistview.bas

对客户管理的系统 运行相应EXE文件前

Attribute VB_Name = "mdlListView"
Option Explicit


Public Sub AddClientToLvw(ByVal objClient As cClient, _
                          ByRef lvw As ListView, _
                          ByVal IsOverWrite As Boolean)
  
  Dim Itm As ListItem
  Dim sIcon As String
  Dim bIcon As String
  
  
  If objClient.Sex = Male Then
    sIcon = "sboy"
    bIcon = "bboy"
  Else
    sIcon = "sgirl"
    bIcon = "bgirl"
  End If
  
  
  If IsOverWrite Then
    Set Itm = lvw.SelectedItem
    If Itm Is Nothing Then Exit Sub
  Else
    Set Itm = lvw.ListItems.Add(, "A" & objClient.ID, , bIcon, sIcon)
  End If
  With objClient
    Itm.SmallIcon = sIcon
    Itm.Icon = bIcon
    Itm.Text = .Name
    Itm.SubItems(1) = .TypeName
    Itm.SubItems(2) = IIf(.Sex = Male, "男", "女")
    Itm.SubItems(3) = .Mobile
    Itm.SubItems(4) = .Email
    Itm.SubItems(5) = IIf(.BirthdayWarn, "启用", "未启用")
  End With
  Set Itm = Nothing
End Sub



Public Sub InitClientListview(ByRef lvw As ListView)
  With lvw
    .ColumnHeaders.Clear
    
    .ColumnHeaders.Add , , "姓名", 1200
    .ColumnHeaders.Add , , "客户类别", 1500
    .ColumnHeaders.Add , , "性别", 500
    .ColumnHeaders.Add , , "手机", 1300
    .ColumnHeaders.Add , , "E-mail", 1500
    .ColumnHeaders.Add , , "生日提醒", 1000
  End With
End Sub


Public Sub ClientsToListview(ByVal objClients As CClients, ByRef lvw As ListView)
  
  Dim i As Long
  
 
  If lvw.ColumnHeaders.Count = 0 Then InitClientListview lvw
  lvw.ListItems.Clear
  
  For i = 1 To objClients.Count
    
    AddClientToLvw objClients.Item(i), lvw, False
  Next i
End Sub


Public Sub ListAllClients(ByRef lvw As ListView)
  Dim objClients As New CClients
  Dim rstClients As CClients
  
  
  Set rstClients = objClients.Find
  
  
  ClientsToListview rstClients, lvw
  
  Set objClients = Nothing
  Set rstClients = Nothing
  
End Sub



Public Function GetClientFromControl(ByVal lvw As Object, _
                                    ByRef objClient As cClient) As Boolean
  
  If lvw.SelectedItem Is Nothing Then
    GetClientFromControl = False
    Exit Function
  End If

  Dim objClients As New CClients
  Dim ID As Long
  
  ID = GetID(lvw.SelectedItem.Key)

  On Error Resume Next
  Set objClient = objClients.Find(ID).Item(1)
  GetClientFromControl = (Err.Number = 0)
End Function


Public Sub ClientsToCombo(ByVal objTypes As CTypes, ByRef cbo As ComboBox)
  
  Dim i As Long
  
  cbo.Clear
  
  For i = 1 To objTypes.Count
    
    Call cbo.AddItem(objTypes.Item(i).TypeName, i - 1)
    cbo.ItemData(i - 1) = objTypes.Item(i).ID
  Next i
  
End Sub

Public Sub AllClientsTypeToCombo(ByRef cbo As ComboBox)
  Dim objTypes As New CTypes
  Dim rstTypes As CTypes
  
  Set rstTypes = objTypes.Find
  ClientsToCombo objTypes, cbo
  
  Set objTypes = Nothing
  Set rstTypes = Nothing
  
End Sub


Public Sub InitWarnListview(ByRef lvw As ListView)
  With lvw
    .ColumnHeaders.Clear
    
    .ColumnHeaders.Add , , "提醒客户", 1000
    .ColumnHeaders.Add , , "显示时间", 1000
    .ColumnHeaders.Add , , "提醒类型", 1000
    .ColumnHeaders.Add , , "提醒内容", 5000
  End With
End Sub

Public Sub AddWarnToLvw(ByVal objWarn As CWarning, ByRef lvw As ListView, ByVal IsOverWrite As Boolean)
  
  Dim Itm As ListItem
  Dim sIcon As String
  Dim bIcon As String
  
  If objWarn.ID = Male Then
    sIcon = "sboy"
    bIcon = "bboy"
  Else
    sIcon = "sgirl"
    bIcon = "bgirl"
  End If
  
  If IsOverWrite Then
    Set Itm = lvw.SelectedItem
    If Itm Is Nothing Then Exit Sub
  Else
    Set Itm = lvw.ListItems.Add(, "W" & objWarn.ID)
  End If
  With objWarn
    Itm.Text = .ClientName
    Itm.SubItems(1) = .ShowDate
    Itm.SubItems(2) = .TypeName
    Itm.SubItems(3) = .Msg
  End With
  Set Itm = Nothing
End Sub


Public Sub WarningsToListview(ByVal objWarns As CWarnings, ByRef lvw As ListView)
  
  Dim i As Long
  
  
  If lvw.ColumnHeaders.Count = 0 Then InitWarnListview lvw
  lvw.ListItems.Clear
  
  For i = 1 To objWarns.Count
    
    AddWarnToLvw objWarns.Item(i), lvw, False
  Next i
End Sub

Public Sub ListAllWarnings(ByRef lvw As ListView)
  Dim objWarnings As New CWarnings
  Dim rstWarnings As CWarnings
  
  Set rstWarnings = objWarnings.Find
  WarningsToListview rstWarnings, lvw
  
  Set objWarnings = Nothing
  Set rstWarnings = Nothing
  
End Sub



Public Function GetWarnFromControl(ByVal lst As Object, ByRef objWarn As CWarning) As Boolean
  
  If lst.SelectedItem Is Nothing Then
    GetWarnFromControl = False
    Exit Function
  End If

  Dim objWarns As New CWarnings
  Dim ID As Long
  
  ID = GetID(lst.SelectedItem.Key)

  On Error Resume Next
  Set objWarn = objWarns.Find(ID).Item(1)
  GetWarnFromControl = (Err.Number = 0)
End Function


Public Sub InitCooperateListview(ByRef lvw As ListView)
  With lvw
    .ColumnHeaders.Clear
    
    .ColumnHeaders.Add , , "合作客户", 1000
    .ColumnHeaders.Add , , "合作时间", 1000
    .ColumnHeaders.Add , , "满意度", 1000
    .ColumnHeaders.Add , , "合作说明", 5000
  End With
End Sub

Public Sub AddCooperateToLvw(ByVal objCoop As CCooperate, ByRef lvw As ListView, ByVal IsOverWrite As Boolean)
  
  Dim Itm As ListItem
  
  If IsOverWrite Then
    Set Itm = lvw.SelectedItem
    If Itm Is Nothing Then Exit Sub
  Else
    Set Itm = lvw.ListItems.Add(, "W" & objCoop.ID)
  End If
  With objCoop
    Itm.Text = .ClientName
    Itm.SubItems(1) = .CooperateDate
    Itm.SubItems(2) = .Satisfaction
    Itm.SubItems(3) = .Remark
  End With
  Set Itm = Nothing
End Sub


Public Sub CooperatesToListview(ByVal objCoops As CCooperates, ByRef lvw As ListView)
  
  Dim i As Long
  
  
  If lvw.ColumnHeaders.Count = 0 Then InitCooperateListview lvw
  lvw.ListItems.Clear
  
  For i = 1 To objCoops.Count
    
    AddCooperateToLvw objCoops.Item(i), lvw, False
  Next i
End Sub

Public Sub ListAllCooperates(ByRef lvw As ListView, Optional ByVal lngClientId As Long = 0)
  Dim objCooperates As New CCooperates
  Dim rstCooperates As CCooperates
  
  Set rstCooperates = objCooperates.Find(, lngClientId)
  CooperatesToListview rstCooperates, lvw
  
  Set objCooperates = Nothing
  Set rstCooperates = Nothing
  
End Sub



Public Function GetCoopFromControl(ByVal lst As Object, ByRef objCoop As CCooperate) As Boolean
 
  If lst.SelectedItem Is Nothing Then
    GetCoopFromControl = False
    Exit Function
  End If

  Dim objCoops As New CCooperates
  Dim ID As Long
  
  ID = GetID(lst.SelectedItem.Key)

  On Error Resume Next
  Set objCoop = objCoops.Find(ID).Item(1)
  GetCoopFromControl = (Err.Number = 0)
End Function