?? mdllistview.bas
字號:
Attribute VB_Name = "mdlListView"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'將單個客戶加入列表,或在列表中更新
'特意將該函數單獨做出來,而沒有將本函數中的代碼完全在ClientsToListview函數中實現
'Why?
'因為在設計該功能時,你還應考慮到在以后的編程過程中,很可能要用到
'將某個單獨的“客戶”對象加入列表框(比如新增加了一個客戶)。
Public Sub AddClientToLvw(ByVal objClient As CClient, _
ByRef lvw As ListView, _
ByVal IsOverWrite As Boolean)
'第三個參數如果是TRUE,則說明是更新當前已存在的某個列表項,否則是新加一個列表項
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 '這里要與InitClientListview相對應
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
'按照“客戶”設置ListView的顯示樣式
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
'將客戶集合顯示到ListView中
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函數
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
'Find的兩個參數均取默認值,此時查找全部的客戶
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
'去除Listview中列表項的KEY屬性前的字母“A”,即為該客戶的ID值
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
'將每個“客戶”都加入到該列表中,調用了單獨的函數,沒有全部做到這
'個函數中,為什么呢?參看AddClientToLvw函數
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'與Warning相關的操作
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'按照“客戶”設置ListView的顯示樣式
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)
'第三個參數如果是TRUE,則說明是更新當前已存在的某個列表項,否則是新加一個列表項
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
'將客戶集合顯示到ListView中
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函數
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
'去除Listview中列表項的KEY屬性前的字母“A”,即為該客戶的ID值
ID = GetID(lst.SelectedItem.Key)
On Error Resume Next '為了防止未查找到,因此加入了錯誤判斷語句
Set objWarn = objWarns.Find(ID).Item(1)
GetWarnFromControl = (Err.Number = 0)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 與合作記錄相關的列表操作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'按照“客戶”設置ListView的顯示樣式
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)
'第三個參數如果是TRUE,則說明是更新當前已存在的某個列表項,否則是新加一個列表項
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
'將客戶集合顯示到ListView中
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
'將每個“客戶”都加入到該列表中,調用了單獨的函數,沒有全部做到這
'個函數中,為什么呢?參看AddCoopToLvw函數
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
'去除Listview中列表項的KEY屬性前的字母“A”,即為該客戶的ID值
ID = GetID(lst.SelectedItem.Key)
On Error Resume Next '為了防止未查找到,因此加入了錯誤判斷語句
Set objCoop = objCoops.Find(ID).Item(1)
GetCoopFromControl = (Err.Number = 0)
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -