实现ListView控件的行间隔颜色的优化代码

崔占民在其文章《用代码实现ListView控件的行间隔颜色》中给出了实现代码,经过笔者测试,发现有如下bug

 

       首先,虽然可以看到背景色间隔,但是条块的高度等于原始picGreenBar的高度。应该在autoredraw属性设置为true之前,将height属性设置为一个最小值,比如1

 

另外,listview的属性要修改一下:
    ...
    ListView1.View = lvwReport
    ListView1.FullRowSelect
= True
    ListView1.GridLines
= True
    picGreenbar.Height
= 1
    
    '
添加一些实验数据
   ....

 

 

为方便读者,将全部代码公布如下(关键代码来自《用代码实现ListView控件的行间隔颜色》):

 

--------------------------------

 

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
   Caption        
=   "Form1"
   ClientHeight    =   5400
   ClientLeft     
=   60
   ClientTop      
=   345
   ClientWidth    
=   5940
   LinkTopic      
=   "Form1"
   ScaleHeight     =   5400
   ScaleWidth     
=   5940
   StartUpPosition
=   3 

   Begin VB.PictureBox picGreenbar
      Height         
=   1695
     
Left            =   120
      ScaleHeight    
=   1282.353
      ScaleMode      
=   0  'User
      ScaleWidth      =   4635
      TabIndex       
=   1
      Top            
=   3480
      Width          
=   4695
  
End
   Begin MSComctlLib.ListView ListView1
      Height         
=   3255
     
Left            =   120
      TabIndex       
=   0
      Top            
=   120
      Width          
=   4695
      _ExtentX       
=   8281
      _ExtentY       
=   5741
      View           
=   3
      Sorted         
=   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FlatScrollBar   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor      
=   -2147483640
      BackColor      
=   -2147483643
      BorderStyle    
=   1
      Appearance     
=   1
      NumItems       
=   0
  
End
End
Attribute VB_Name
= "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable
= False
Attribute VB_PredeclaredId
= True
Attribute VB_Exposed
= False
Option Explicit


Private Sub Form_Load()

   
Dim j As Integer
   
Dim itmX As ListItem
   
    ListView1.ColumnHeaders.Add , ,
"This is Just a Simple Example"
    ListView1.ColumnHeaders(1).Width = 3000
   
    ListView1.View
= lvwReport
    ListView1.FullRowSelect
= True
    ListView1.GridLines
= True
    picGreenbar.Height
= 1
   
   
'添加一些实验数据
    For j = 1 To 33
       
Set itmX = ListView1.ListItems.Add()
        itmX.Text
= "This is item number " & CStr(j)
   
Next j
   
   
Call ColorListView(Me.ListView1, Me.picGreenbar)

End Sub

Private Sub Form_Resize()
    ListView1.Width
= Me.ScaleWidth
End Sub
Private Sub ColorListView(ListView1 As ListView, picGreenbar As PictureBox)
   
Dim i As Integer
   
Dim iFontHeight As Long
   
Dim iBarHeight As Integer
   
Dim ColHead As ColumnHeader
    Me.ScaleMode
= vbTwips
    picGreenbar.ScaleMode
= vbTwips
    picGreenbar.BorderStyle
= vbBSNone
    picGreenbar.AutoRedraw
= True
    picGreenbar.Visible
= False
    picGreenbar.Font
= ListView1.Font
    iFontHeight
= picGreenbar.TextHeight("b") + Screen.TwipsPerPixelY
    iBarHeight
= (iFontHeight * 1)
    picGreenbar.Width
= ListView1.Width
   
'======
    picGreenbar.Height = iBarHeight * 2
    picGreenbar.ScaleMode
= vbUser
    picGreenbar.ScaleHeight
= 2
    picGreenbar.ScaleWidth
= 1
   
'draw the actual bars
    picGreenbar.Line (0, 0)-(1, 1), &HE7E8FC, BF
    picGreenbar.Line (
0, 1)-(1, 2), RGB(0, 255, 0), BF
   
'======
    ListView1.PictureAlignment = lvwTile
    ListView1.Picture
= picGreenbar.Image
End Sub

 

 

 

 

 

 

 

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值