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 
|
本类阅读TOP10