給listview的各行設置不同的顏色

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
 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章