Private
Sub SetListItemColor()
Sub SetListItemColor()
If mlvwPlayList.ListItems.Count = 0 Then Exit Sub
If picBgBox Is Nothing Then Err.Raise vbObjectError + 1001, "Object PlayList", "Property PictureBox need to be set."
Dim i As Long, j As Long, BgColor As Long, FontColor As Long
Dim ScrollHeight As Single
Dim mItem As ListItem
mlvwPlayList.Picture = LoadPicture()
mlvwPlayList.Parent.ScaleMode = vbTwips
With picBgBox
.Picture = LoadPicture()
.Cls
.BackColor = RGB(&HFF, &HFF, &HFF)
.ScaleMode = vbTwips
'.BorderStyle = vbBSNone
.AutoRedraw = True
.Visible = False
.Width = 1
.Height = mlvwPlayList.ListItems(1).Height * (mlvwPlayList.ListItems.Count)
.DrawWidth = 1
End With
ScrollHeight = mlvwPlayList.ListItems(1).Top
For i = 1 To mlvwPlayList.ListItems.Count
Set mItem = mlvwPlayList.ListItems(i)
FontColor = clrItemFontColor
If i Mod 2 = 0 Then
BgColor = clrItemBgColorNormal
Else
BgColor = clrItemBgColorAlter
End If
mItem.ForeColor = FontColor
For j = 1 To mItem.ListSubItems.Count
mItem.ListSubItems.Item(j).ForeColor = FontColor
Next j
picBgBox.Line (0, mItem.Top - ScrollHeight)-(0, mItem.Top - ScrollHeight + mItem.Height), BgColor, BF
Next
mlvwPlayList.PictureAlignment = lvwTile
mlvwPlayList.Picture = picBgBox.Image
End Sub
If mlvwPlayList.ListItems.Count = 0 Then Exit Sub
If picBgBox Is Nothing Then Err.Raise vbObjectError + 1001, "Object PlayList", "Property PictureBox need to be set."
Dim i As Long, j As Long, BgColor As Long, FontColor As Long
Dim ScrollHeight As Single
Dim mItem As ListItem
mlvwPlayList.Picture = LoadPicture()
mlvwPlayList.Parent.ScaleMode = vbTwips
With picBgBox
.Picture = LoadPicture()
.Cls
.BackColor = RGB(&HFF, &HFF, &HFF)
.ScaleMode = vbTwips
'.BorderStyle = vbBSNone
.AutoRedraw = True
.Visible = False
.Width = 1
.Height = mlvwPlayList.ListItems(1).Height * (mlvwPlayList.ListItems.Count)
.DrawWidth = 1
End With
ScrollHeight = mlvwPlayList.ListItems(1).Top
For i = 1 To mlvwPlayList.ListItems.Count
Set mItem = mlvwPlayList.ListItems(i)
FontColor = clrItemFontColor
If i Mod 2 = 0 Then
BgColor = clrItemBgColorNormal
Else
BgColor = clrItemBgColorAlter
End If
mItem.ForeColor = FontColor
For j = 1 To mItem.ListSubItems.Count
mItem.ListSubItems.Item(j).ForeColor = FontColor
Next j
picBgBox.Line (0, mItem.Top - ScrollHeight)-(0, mItem.Top - ScrollHeight + mItem.Height), BgColor, BF
Next
mlvwPlayList.PictureAlignment = lvwTile
mlvwPlayList.Picture = picBgBox.Image
End Sub
對了,以上提到的,mlvwPlayList:mlvwPlayList.PictureAlignment = lvwTile
如果繪製整塊Item背景而不用平鋪的背景,則運行效率十分低!!七百多條數據就很慢了。
所以注意上面:picBgBox.Width = 1