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"

'/* 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)

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

lv.Picture = picBg.Image

End Sub

另一种方法
Option Explicit

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

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)

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

'/* 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

'/* Create some fake data
For cnt = 1 To 100

'/* 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

Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER)

End Sub