listview的隔行显示不同颜色

listview的隔行显示不同颜色
Option Explicit

Private Enum ImageSizingTypes
   [sizeNone] = 0
   [sizeCheckBox]
   [sizeIcon]
End Enum

Private Enum LedgerColours
  vbledgerWhite = &HF9FEFF
  vbLedgerGreen = &HD0FFCC
  vbLedgerYellow = &HE1FAFF
  vbLedgerRed = &HE1E1FF
  vbLedgerGrey = &HE0E0E0
  vbLedgerBeige = &HD9F2F7
  vbLedgerSoftWhite = &HF7F7F7
  vbledgerPureWhite = &HFFFFFF
End Enum

'/* Below used for listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Sub SetListViewLedgerRows(lv As ListView, _
                                  Bar1Color As LedgerColours, _
                                  Bar2Color As LedgerColours, _
                                  nSizingType As ImageSizingTypes, _
                                  Optional nRowsPerBar As Long = 1)
 
   Dim iBarHeight  As Long  '/* height of 1 line in the listview
   Dim lBarWidth   As Long  '/* width of listview
   Dim diff        As Long  '/* used in calculations of row height
   Dim twipsy      As Long  '/* var holding Screen.TwipsPerPixelY
  
   iBarHeight = 0
   lBarWidth = 0
   diff = 0
  
   On Local Error GoTo SetListViewColor_Error
  
   twipsy = Screen.TwipsPerPixelY
  
   If lv.View = lvwReport Then
  
     '/* set up the listview properties
      With lv
        .Picture = Nothing  '/* clear picture
        .Refresh
        .Visible = 1
        .PictureAlignment = lvwTile
        lBarWidth = .Width
      End With  ' lv
       
     '/* set up the picture box properties
      With Picture1
         .AutoRedraw = False       '/* clear/reset picture
         .Picture = Nothing
         .BackColor = vbWhite
         .Height = 1
         .AutoRedraw = True        '/* assure image draws
         .BorderStyle = vbBSNone   '/* other attributes
         .ScaleMode = vbTwips
         .Top = Form1.Top - 10000  '/* move it way off screen
         .Width = Screen.Width
         .Visible = False
         .Font = lv.Font           '/* assure font matches listview font
        
        '/* match picture box font properties
        '/* with those of listview
         With .Font
            .Bold = lv.Font.Bold
            .Charset = lv.Font.Charset
            .Italic = lv.Font.Italic
            .Name = lv.Font.Name
            .Strikethrough = lv.Font.Strikethrough
            .Underline = lv.Font.Underline
            .Weight = lv.Font.Weight
            .Size = lv.Font.Size
         End With  'Picture1.Font
        
        '/* here we calculate the height of each
        '/* bar in the listview. Several things
        '/*  can affect this height - the use
        '/* of item icons, the size of those icons,
        '/* the use of checkboxes and so on through
        '/* all the permutations.
        '/*
        '/* Shown here is code sufficient to calculate
        '/* this height based on three combinations of
        '/*  data, state icons, and imagelist icons:
        '/*
        '/* 1. text only
        '/* 2. text with checkboxes
        '/* 3. text with icons
       
       '/* used by all sizing routines
         iBarHeight = .TextHeight("W")
 
         Select Case nSizingType
            Case sizeNone:
              '/* 1. text only
               iBarHeight = iBarHeight + twipsy
              
            Case sizeCheckBox:
              '/* 2. text with checkboxes: add to TextHeight the
              '/*    difference between 18 pixels and iBarHeight
              '/*    all calculated initially in pixels,
              '/*    then converted to twips
               If (iBarHeight / twipsy) > 18 Then
                  iBarHeight = iBarHeight + twipsy
               Else
                  diff = 18 - (iBarHeight / twipsy)
                  iBarHeight = iBarHeight + (diff * twipsy) + twipsy
               End If
              
            Case sizeIcon:
              '/* 3. text with icons: add to TextHeight the
              '/*    difference between TextHeight and image
              '/*    height, all calculated initially in pixels,
              '/*    then converted to twips. Handles 16x16 icons
               diff = imagelist1.ImageHeight - (iBarHeight / twipsy)
               iBarHeight = iBarHeight + (diff * twipsy) + twipsy
              
         End Select
     
        '/* since we need two-tone bars, the
        '/* picturebox needs to be twice as
        '/* high as the number of rows desired
         .Height = iBarHeight * (2 * nRowsPerBar)
         .Width = lBarWidth
        
        '/* paint the two bars of color and refresh
        '/* Note: The line method does not support
        '/* With/End With blocks
         Picture1.Line (0, 0)-(lBarWidth, _
                       (iBarHeight * nRowsPerBar)), Bar1Color, BF
         Picture1.Line (0, (iBarHeight * nRowsPerBar))-(lBarWidth, _
                       (iBarHeight * (2 * nRowsPerBar))), Bar2Color, BF
     
         .AutoSize = True
         .Refresh
        
      End With  'Picture1
    
     '/* set the lv picture to the
     '/* Picture1 image
      lv.Refresh: lv.Picture = Picture1.Image
     
   Else
   
      lv.Picture = Nothing
       
   End If  'lv.View = lvwReport
 
SetListViewColor_Exit:
   On Local Error GoTo 0
Exit Sub
   
SetListViewColor_Error:
 
  '/* clear the listview's picture and exit
   With lv
      .Picture = Nothing
      .Refresh
   End With
  
   Resume SetListViewColor_Exit
   
End Sub

 

Private Sub Form_Load()

   Command1.Caption = "Text Only"
   Command2.Caption = "Text && Checks"
   Command3.Caption = "Text && Icons"
  
   With Combo1
      .AddItem 1
      .AddItem 2
      .AddItem 3
      .AddItem 4
      .AddItem 5
      .ListIndex = 0
   End With
  
End Sub

Private Sub Command1_Click()
 
   With ListView1
      .Visible = False           '/* Slimy workaround for listview redraw problem
      .Checkboxes = False
      .FullRowSelect = True
      .HideSelection = True
       Set .SmallIcons = Nothing

      Call LoadData(sizeNone)
      Call SetListViewLedgerRows(ListView1, _
                              vbLedgerYellow, _
                              vbLedgerGrey, _
                              sizeNone, _
                              Combo1.List(Combo1.ListIndex))
      .Refresh
      .Visible = True            '/* Restore visibility
   End With

End Sub

Private Sub Command2_Click()

   With ListView1
      .Visible = False
      .Checkboxes = True
      .FullRowSelect = True
      Set .SmallIcons = Nothing
  
      Call LoadData(sizeCheckBox)
      Call SetListViewLedgerRows(ListView1, _
                              vbLedgerYellow, _
                              vbLedgerGrey, _
                              sizeCheckBox, _
                              Combo1.List(Combo1.ListIndex))
      .Refresh
      .Visible = True
   End With
  
End Sub

天﹐怎么這么長呀。
Private Sub Command3_Click()

   With ListView1
      .Visible = False
      .Checkboxes = False
      .FullRowSelect = True
      Set .SmallIcons = imagelist1
  
      Call LoadData(sizeIcon)
      Call SetListViewLedgerRows(ListView1, _
                              vbLedgerYellow, _
                              vbLedgerGrey, _
                              sizeIcon, _
                              Combo1.List(Combo1.ListIndex))
     
      .Refresh
      .Visible = True
   End With
  
   Command1.Enabled = False
  
End Sub

Private Sub LoadData(nSizingType As ImageSizingTypes)

   Dim cnt As Long
   Dim itmX As ListItem
  
   With ListView1
      .ListItems.Clear
      .ColumnHeaders.Clear
      .ColumnHeaders.Add , , "Number"
      .ColumnHeaders.Add , , "Time"
      .ColumnHeaders.Add , , "User"
      .ColumnHeaders.Add , , "Tag"
      .View = lvwReport
      .Sorted = False
   End With
  
  '/* Create some fake data
   For cnt = 1 To 100
  
      Set itmX = Form1.ListView1.ListItems.Add(, , Format$(cnt, "###"))
      If nSizingType = sizeIcon Then itmX.SmallIcon = 1
      itmX.SubItems(1) = Format$(Time, "hh:mm:ss am/pm")
      itmX.SubItems(2) = "RGB-T"
      itmX.SubItems(3) = "SYS-1234"
        
   Next

  '/* Now that the control contains data, this
  '/* causes the columns to resize to fit the items
   Call lvAutosizeControl(Form1.ListView1)
  
End Sub

Private Sub lvAutosizeControl(lv As ListView)

   Dim col2adjust As Long

  '/* Size each column based on the maximum of
  '/* EITHER the columnheader text width, or,
  '/* if the items below it are wider, the
  '/* widest list item in the column
   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
  
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)

   Next
  
End Sub
來﹐換個簡單的﹐不過pic的高度自己調整
 Dim i As Integer, j As Integer, iBarHeight As Integer
   Dim iFontHeight As Long
   Dim itemx As ListItem
   Dim ColHead As ColumnHeader
   
    picGreenbar.BackColor = RGB(240, 240, 240)
    Me.picGreenbar.Height = 510
    lvwRecord.View = lvwReport
    Me.ScaleMode = vbTwips
    picGreenbar.ScaleMode = vbTwips
    picGreenbar.BorderStyle = vbBSNone
    picGreenbar.AutoRedraw = True
    picGreenbar.Visible = False
    picGreenbar.Font = lvwRecord.Font
    iFontHeight = picGreenbar.TextHeight("b") + Screen.TwipsPerPixelY
    iBarHeight = (iFontHeight * 2)
    picGreenbar.Width = lvwRecord.Width

    picGreenbar.ScaleMode = vbUser
    picGreenbar.ScaleHeight = 2
    picGreenbar.ScaleWidth = 1 '
  
    picGreenbar.Line (0, 0)-(1, 1), vbWhite, BF
   lvwRecord.PictureAlignment = lvwTile
   lvwRecord.Picture = picGreenbar.Image
   
   Set lvwRecord.SmallIcons = Me.ImageList1

 

但是在VB中，没有这个方法，但是可以设置它的背景图片，以前在网上搜索看到有关这方面的文章设置背景颜色都是设置相同间隔相同颜色（因为是用一张图片以Title的方式贴上去的），所以看来偷懒不成，自己写吧，真正动手去写才发现原来很简单。

Private Sub SetListItemColor(lv As ListView, picBg As PictureBox)

   Dim i As Integer

   Dim mItem As ListItem

   picBg.BackColor = lv.BackColor

   lv.Parent.ScaleMode = vbTwips

    picBg.ScaleMode = vbTwips

    picBg.BorderStyle = vbBSNone

    picBg.AutoRedraw = True

    picBg.Visible = False

   

    picBg.Width = lv.Width

    picBg.Height = lv.ListItems(1).Height * (lv.ListItems.Count)

    picBg.ScaleHeight = lv.ListItems.Count

    picBg.ScaleWidth = 1

    picBg.DrawWidth = 1

    '-----------------------------

    'custom.such as

    '------------------------------

    For i = 1 To 33

        Set mItem = lv.ListItems

        If mItem.Checked = False Then

            If i Mod 2 = 0 Then

                picBg.Line (0, i - 1)-(1, i), RGB(254, 209, 199), BF

            Else

               picBg.Line (0, i - 1)-(1, i), RGB(20, 54, 199), BF

            End If

        Else

             picBg.Line (0, i - 1)-(1, i), RGB(254, 200, 100), BF

        End If

    Next
 
    lv.Picture = picBg.Image

End Sub

 

另一种方法
Option Explicit

Private Enum ImageSizingTypes
   [sizeNone] = 0
   [sizeCheckBox]
   [sizeIcon]
End Enum

Private Enum LedgerColours
  vbledgerWhite = &HF9FEFF
  vbLedgerGreen = &HD0FFCC
  vbLedgerYellow = &HE1FAFF
  vbLedgerRed = &HE1E1FF
  vbLedgerGrey = &HE0E0E0
  vbLedgerBeige = &HD9F2F7
  vbLedgerSoftWhite = &HF7F7F7
  vbledgerPureWhite = &HFFFFFF
End Enum

'/* Below used for listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Sub Form_Load()

   Command1.Caption = "Text Only"
   Command2.Caption = "Text && Checks"
   Command3.Caption = "Text && Icons"
  
End Sub

Private Sub Command1_Click()
 
   With ListView1
      .Visible = False
      .Checkboxes = False
      .FullRowSelect = True
       Set .SmallIcons = Nothing

      Call LoadData(sizeNone)
      Call SetListViewLedger(ListView1, _
                             vbLedgerYellow, _
                             vbLedgerGrey, _
                             sizeNone)
     
      .Refresh
      .Visible = True            '/* Restore visibility
   End With

End Sub

Private Sub Command2_Click()

   With ListView1
      .Visible = False
      .Checkboxes = True
      .FullRowSelect = True
      Set .SmallIcons = Nothing
  
      Call LoadData(sizeCheckBox)
      Call SetListViewLedger(ListView1, _
                             vbLedgerYellow, _
                             vbLedgerGrey, _
                             sizeCheckBox)
           
      .Refresh
      .Visible = True
   End With
  
End Sub

Private Sub Command3_Click()

   With ListView1
      .Visible = False
      .Checkboxes = False
      .FullRowSelect = True
      Set .SmallIcons = imagelist1
  
      Call LoadData(sizeIcon)
      Call SetListViewLedger(ListView1, _
                             vbLedgerYellow, _
                             vbLedgerGrey, _
                             sizeIcon)
     
      .Refresh
      .Visible = True
   End With
  
   Command1.Enabled = False
  
End Sub

Private Sub SetListViewLedger(lv As ListView, _
                              Bar1Color As LedgerColours, _
                              Bar2Color As LedgerColours, _
                              nSizingType As ImageSizingTypes)

   Dim iBarHeight  As Long  '/* height of 1 line in the listview
   Dim lBarWidth   As Long  '/* width of listview
   Dim diff        As Long  '/* used in calculations of row height
   Dim twipsy      As Long  '/* variable holding Screen.TwipsPerPicture1elY
  
   iBarHeight = 0
   lBarWidth = 0
   diff = 0
  
   On Local Error GoTo SetListViewColor_Error
  
   twipsy = Screen.TwipsPerPixelY
  
   If lv.View = lvwReport Then
  
     '/* set up the listview properties
      With lv
        .Picture = Nothing  '/* clear picture
        .Refresh
        .Visible = 1
        .PictureAlignment = lvwTile
        lBarWidth = .Width
      End With  ' lv
       
     '/* set up the picture box properties
      With Picture1
         .AutoRedraw = False       '/* clear/reset picture
         .Picture = Nothing
         .BackColor = vbWhite
         .Height = 1
         .AutoRedraw = True        '/* assure image draws
         .BorderStyle = vbBSNone   '/* other attributes
         .ScaleMode = vbTwips
         .Top = Form1.Top - 10000  '/* move it way off screen
         .Width = Screen.Width        
         .Visible = False
         .Font = lv.Font           '/* assure Picture1 font matched listview font
        
        '/* match picture box font properties
        '/* with those of listview
         With .Font
            .Bold = lv.Font.Bold
            .Charset = lv.Font.Charset
            .Italic = lv.Font.Italic
            .Name = lv.Font.Name
            .Strikethrough = lv.Font.Strikethrough
            .Underline = lv.Font.Underline
            .Weight = lv.Font.Weight
            .Size = lv.Font.Size
         End With  'Picture1.Font
        
        '/* here we calculate the height of each
        '/* bar in the listview. Several things
        '/*  can affect this height - the use
        '/* of item icons, the size of those icons,
        '/* the use of checkboxes and so on through
        '/* all the permutations.
        '/*
        '/* Shown here is code sufficient to calculate
        '/* this height based on three combinations of
        '/*  data, state icons, and imagelist icons:
        '/*
        '/* 1. text only
        '/* 2. text with checkboxes
        '/* 3. text with icons
       
       '/* used by all sizing routines
         iBarHeight = .TextHeight("W")

         Select Case nSizingType
            Case sizeNone:
              '/* 1. text only
               iBarHeight = iBarHeight + twipsy
              
            Case sizeCheckBox:
              '/* 2. text with checkboxes: add to textheight the
              '/*    difference between 18 Pixels and iBarHeight
              '/*    all calculated initially in Pixels,
              '/*    then converted to twips
               If (iBarHeight / twipsy) > 18 Then
                  iBarHeight = iBarHeight + twipsy
               Else
                  diff = 18 - (iBarHeight / twipsy)
                  iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
               End If
              
            Case sizeIcon:
              '/* 3. text with icons: add to textheight the
              '/*    difference between textheight and image
              '/*    height, all calculated initially in Pixels,
              '/*    then converted to twips. Handles 16x16 icons
               diff = imagelist1.ImageHeight - (iBarHeight / twipsy)
               iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
              
         End Select
     
        '/* since we need two-tone bars, the
        '/* picturebox needs to be twice as high
         .Height = iBarHeight * 2
         .Width = lBarWidth
        
        '/* paint the two bars of color and refresh
        '/* Note: The line method does not support
        '/* With/End With blocks
         Picture1.Line (0, 0)-(lBarWidth, iBarHeight), Bar1Color, BF
         Picture1.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Bar2Color, BF
     
         .AutoSize = True
         .Refresh
        
      End With  'Picture1
    
     '/* set the lv picture to the
     '/* Picture1 image
    
      lv.Refresh
      lv.Picture = Picture1.Image
     
   Else
   
      lv.Picture = Nothing
       
   End If  'lv.View = lvwReport

SetListViewColor_Exit:
On Local Error GoTo 0
Exit Sub
   
SetListViewColor_Error:

  '/* clear the listview's picture and exit
   With lv
      .Picture = nothing
      .Refresh
   End With
  
   Resume SetListViewColor_Exit
   
End Sub

Private Sub LoadData(nSizingType As ImageSizingTypes)

   Dim cnt As Long
   Dim itmX As ListItem
  
   With ListView1
      .ListItems.Clear
      .ColumnHeaders.Clear
      .ColumnHeaders.Add , , "Number"
      .ColumnHeaders.Add , , "Time"
      .ColumnHeaders.Add , , "User"
      .ColumnHeaders.Add , , "Tag "
      .View = lvwReport
      .Sorted = False
   End With
  
  '/* Create some fake data
   For cnt = 1 To 100
  
      Set itmX = Form1.ListView1.ListItems.Add(, , Format$(cnt, "###"))
      If nSizingType = sizeIcon Then itmX.SmallIcon = 1
      itmX.SubItems(1) = Format$(Time, "hh:mm:ss am/pm")
      itmX.SubItems(2) = "RGB-T"
      itmX.SubItems(3) = "SYS-1234"
        
   Next

  '/* Now that the control contains data, this
  '/* causes the columns to resize to fit the items
   Call lvAutosizeControl(Form1.ListView1)
  
  
End Sub

Private Sub lvAutosizeControl(lv As ListView)

   Dim col2adjust As Long

  '/* Size each column based on the maximum of
  '/* EITHER the columnheader text width, or,
  '/* if the items below it are wider, the
  '/* widest list item in the column
   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
  
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)

   Next
  
  
End Sub