如何给Listview做个背景

Question

Public Sub SetColorBar(cListView As ListView, cColorBar As PictureBox, Optional lColor1 As Long = &HE2F1E3, Optional lColor2 As Long = vbWhite)
Dim iLineHeight As Long
Dim iBarHeight As Long
Dim lBarWidth As Long
On Error Goto SetColorBarError
    If cListView.View = lvwReport Then
        cColorBar.AutoRedraw = True
        cColorBar.BorderStyle = vbBSNone
        cColorBar.ScaleMode = vbTwips
        cColorBar.Visible = False
        cColorBar.Font = cListView.Font
        iLineHeight = cColorBar.TextHeight("|") + Screen.TwipsPerPixelY
        iBarHeight = iLineHeight * 3
        lBarWidth = cListView.Width
        cColorBar.Height = iBarHeight * 2
        cColorBar.Width = lBarWidth
        cColorBar.Line (0, 0)-(lBarWidth, iBarHeight), lColor1, BF
        cColorBar.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), lColor2, BF
    End If
    cListView.PictureAlignment = lvwTile
    cListView.Picture = cColorBar.Image
End Sub

Answer 1

多谢chenwhenlong(网际浪子)
这88分是你的了我还有个问题向你请教
如果GridLine属性设为True
那每行的颜色是否能控制?
我愿为这个问题再加分
希望大家参与

Answer 2

设置Picture属性即可。
对于每行颜色我记得在哪本书上见过，等我查一查，回头有消息再告诉你。

Answer 3

把上面的过程改一改不就行了。参考下面程式
For i = 1 To lvFileObjects.ListItems.count
    If lvFileObjects.ListItems(i).Checked = True Then
        strFileName = lvFileObjects.ListItems(i).Text
        strFileNamePath = App.Path & "\data\" & lvFileObjects.ListItems(i).Text
        Call cmdPut_Click
        lvFileObjects.ListItems(i).ForeColor = vbBlue
        Call BeginProc
        lvFileObjects.ListItems(i).SubItems(4) = "发送成功"
    Else
        lvFileObjects.ListItems(i).SubItems(4) = "用户取消"
    End If
    
Next i

Answer 4

TO sunbf(富): 控制是可以控制的，不过比较复杂一点。
我这几天比较忙，来这里的时间比较少没有机会来看。你可以将你的邮箱告诉我，下次我将源码发给你！
      E-mail: [email protected](有邮件到达我的手机就会收到短信的)

Answer 5

：　chenwhenlong(网际浪子)
贴上来，让我们也看看

Answer 6

多谢chenwhenlong(网际浪子)　
我的邮箱:[email protected]

Answer 7

sunbf你好，源码我已经发过来了！

Answer 8

Private Sub Command1_Click()
    lvList.GridLines = Not lvList.GridLines
    SetBackColor lvList, vbRed, vbWhite
End SubPrivate Sub Form_Load()
Dim i As Long, lvItem As ListItem
    For i = 1 To 450
        Set lvItem = lvList.ListItems.Add(, , "演示 " & i)
        If i Mod 2 = 0 Then lvItem.Checked = True Else lvItem.Checked = False
    Next i
    
    SetBackColor lvList, picBoard, vbRed, vbGreen
End SubPrivate Function SetBackColor(lvList As ListView, picBoard As PictureBox, CheckColor As ColorConstants, unCheckColor As ColorConstants)
Dim iWidth As Single, iHeight As Single, tHeight As Single, lMatch As Single
Dim i As Long
    With picBoard
        .AutoRedraw = True
        .BackColor = lvList.BackColor
        .Cls
        .Visible = False
        .ScaleMode = vbTwips
        .Width = lvList.Width + 100
        .Height = lvList.ListItems(1).Height * (lvList.ListItems.Count + 1)
        With .Font
            .Size = lvList.Font.Size + 2.75
            .Bold = lvList.Font.Bold
            .Charset = lvList.Font.Charset
            .Italic = lvList.Font.Italic
            .Name = lvList.Font.Name
            .Strikethrough = lvList.Font.Strikethrough
            .Underline = lvList.Font.Underline
            .Weight = lvList.Font.Weight
        End With
        
        iWidth = .Width        For i = 1 To lvList.ListItems.Count
            If i = 1 Then lMatch = lvList.ListItems(i).Top - lvList.ListItems(i).Height
            tHeight = lvList.ListItems(i).Top - lvList.ListItems(i).Height - lMatch
            iHeight = lvList.ListItems(i).Height
            If lvList.ListItems(i).Checked Then
                picBoard.Line (0, tHeight)-(iWidth, tHeight + iHeight), CheckColor, BF
            Else
                picBoard.Line (0, tHeight)-(iWidth, tHeight + iHeight), unCheckColor, BF
            End If
        Next
    End With
    lvList.Picture = picBoard.Image
End Function

Answer 9

sunbf,邮箱好象有问题。我将源码贴出来了！
说明：
     在工程中添加一个ListView控件，Command控件，PictureBox控件。
     调用方法为：
              SetBackColor ListView控件名称,PictureBox控件名称,ListItem的Checck为True时的颜色，ListItem的Check为False时的颜色

Answer 10

再次感谢chenwhenlong(网际浪子)
给分

Answer 11

very good 
mail to me

Answer 12

能不能也把代码 发给我啊
谢谢！
[email protected]