Public Sub SetListViewColor(ByRef LV As ListView)
'' ==========================================================
' 開發人員:段利慶
' 編寫時間:06-12-05
' 過程名稱:SetListViewColor
' 參數說明:Lv ListView
' picBg PictureBox
'
' 功能說明:美化<ListView> 列表隔行顯示兩種顏色
' 注意:繪圖用的<PictureBox>是臨時生成的,使用後就會銷燬
'
' 在使用這個功能的窗體<Form_Load>事件,
' 必須定義<LISTVIEW>和<隱藏的圖片框>所在的窗體
' Set objData.FrmName = Me
'' ==========================================================
'*中央錯誤處理
On Error GoTo PROC_ERR
'*可能出先窗體載入<pic>時。已經加載的還沒有卸載
'*原因是在一個窗體上使用了兩個 <ListView>
'On Error Resume Next
'如果不是LISTVIEW對象使用的是報表視圖
If Not LV.View = lvwReport Then
'設置LISTVIEW 的圖片屬性 等於 空
Set LV.Picture = Nothing
GoTo PROC_EXIT
End If
Dim picBg As PictureBox
'定義一個對象變量,類型是PictureBox
'從FrmName這個屬性得到要載入這個PictureBox的窗體名稱
'並在這個窗體上載入一個PictureBox
'PictureBox的名字是“PIC”
Set picBg = FrmName.Controls.Add("VB.PictureBox", "pic")
'*清除原來繪製的顏色
Set LV.Picture = Nothing
If LV.ListItems.Count = 0 Then
GoTo PROC_EXIT
End If
Dim LastCmd As Integer
Dim i As Integer
LastCmd = 2
'設置 CtlPicBox 這個對象的屬性
With picBg
.BackColor = LV.BackColor
.ScaleMode = vbTwips
.BorderStyle = vbBSNone
.AutoRedraw = True
.Visible = False
If LV.Width < LV.ListItems.Item(1).Width Then
.Width = LV.ListItems.Item(1).Width
Else
.Width = LV.Width
End If
.Height = LV.ListItems(1).Height * (LV.ListItems.Count)
.ScaleHeight = LV.ListItems.Count
.ScaleWidth = 1
.DrawWidth = 1
.Cls
End With
For i = 1 To LV.ListItems.Count
If i Mod 2 = 0 Then
picBg.Line (0, i - 1)-(1, i), &HFFFFC0, BF
Else
picBg.Line (0, i - 1)-(1, i), &HFFC0C0, BF
End If
Next
LV.Picture = picBg.Image
'從窗體上刪除用來畫線的不可見圖片框
FrmName.Controls.Remove "pic"
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox " ErrNumber: " & Err.Number & vbCrLf & _
"ErrDescription: " & Err.Description & vbCrLf & _
" Module: " & "ClsData" & vbCrLf & _
" Procedure: " & "SetListViewColor", vbExclamation
GoTo PROC_EXIT
End Sub