vb.net 中给ListView 添加进度条

'--------------------------------------------------
'
' 窗体 - 带进度条的 ListView
'
' namespace: WoodCoal.Library.Windows.Forms.ListViewProgress
' author: 木炭(WoodCoal)
' homepage: http://www.woodcoal.cn/
' memo: 带进度条的 ListView
' release: 2009-06-04
'
'--------------------------------------------------

Namespace Windows.Forms
Public Class ListViewProgress
Inherits System.Windows.Forms.ListView

''' <summary>进度条内容</summary>
Private _ProgressText As String

''' <summary>进度条背景色</summary>
Private _ProgressBackColor As Drawing.Color

''' <summary>进度条文字色</summary>
Private _ProgressTextColor As Drawing.Color

''' <summary>进度条的序列</summary>
Private _ProgressColumnIndex As Integer = -1

'----------------------------------------------------------------

Public Sub New()
Me.Name = "ProgressListView"
Me.ProgressBackColor = Drawing.Color.YellowGreen
Me.ProgressTextColor = MyBase.ForeColor

MyBase.OwnerDraw = True
End Sub


'----------------------------------------------------------------

''' <summary>进度条背景色</summary>
Public Property ProgressBackColor() As Drawing.Color
Get
Return _ProgressBackColor
End Get
Set(ByVal value As Drawing.Color)
_ProgressBackColor = value
End Set
End Property

''' <summary>进度条文字色</summary>
Public Property ProgressTextColor() As Drawing.Color
Get
Return _ProgressTextColor
End Get
Set(ByVal value As Drawing.Color)
_ProgressTextColor = value
End Set
End Property

''' <summary>进度条的序列</summary>
Public Property ProgressColumnIndex() As Integer
Get
Return _ProgressColumnIndex
End Get
Set(ByVal value As Integer)
_ProgressColumnIndex = value
End Set
End Property

'----------------------------------------------------------------

Protected Overloads Overrides Sub OnDrawColumnHeader(ByVal e As

System.Windows.Forms.DrawListViewColumnHeaderEventArgs)
e.DrawDefault = True
MyBase.OnDrawColumnHeader(e)
End Sub

Protected Overloads Overrides Sub OnDrawSubItem(ByVal e As

System.Windows.Forms.DrawListViewSubItemEventArgs)
If e.ColumnIndex = Me.ProgressColumnIndex Then
'画进度条
Dim ProgressGraphics As Drawing.Graphics = e.Graphics
Dim ProgressRect As New Drawing.Rectangle(e.Bounds.Left,e.Bounds.Top,e.Bounds.Width,

e.Bounds.Height)

If ProgressRect.Height > 6 AndAlso ProgressRect.Width > 6 Then
'调整为新的区域,以便产生一定的间距
ProgressRect = New Drawing.Rectangle(ProgressRect.Left + 2,ProgressRect.Top + 2,

ProgressRect.Width - 5,ProgressRect.Height - 5)

Dim Percent As Single = 0
If Common.String.Validate.Number(e.SubItem.Text) Then
Percent = Single.Parse(e.SubItem.Text)
If Percent >= 1.0F Then Percent = Percent / 100.0F
End If

'外框
ProgressGraphics.FillRectangle(Drawing.Brushes.White,ProgressRect)
ProgressGraphics.DrawRectangle(New Drawing.Pen(e.SubItem.ForeColor),ProgressRect)

'内容
Dim ProgressContentRect As New Drawing.Rectangle(ProgressRect.Left + 1,ProgressRect.Top + 1,

CInt((ProgressRect.Width * Percent)) - 1,ProgressRect.Height - 1)
ProgressGraphics.FillRectangle(New Drawing.SolidBrush(_ProgressBackColor),

ProgressContentRect)

'输出文字
If e.SubItem.Font.Height < ProgressRect.Height Then
ProgressRect = New Drawing.Rectangle(ProgressRect.Left,ProgressRect.Top - Int(-

(ProgressRect.Height - e.SubItem.Font.Height) / 2),ProgressRect.Width,e.SubItem.Font.Height)
Else
ProgressRect = New Drawing.Rectangle(ProgressRect.Left + 1,

ProgressRect.Width - 1,ProgressRect.Height - 1)
End If
Using StringFormat As New Drawing.StringFormat
StringFormat.Alignment = Drawing.StringAlignment.Center
StringFormat.LineAlignment = Drawing.StringAlignment.Center
StringFormat.Trimming = Drawing.StringTrimming.EllipsisCharacter

e.Graphics.DrawString(Percent.ToString("p1"),e.SubItem.Font,New

System.Drawing.SolidBrush(Me.ProgressTextColor),ProgressRect,StringFormat)
End Using
End If

MyBase.OnDrawSubItem(e)
Else
e.DrawDefault = True
MyBase.OnDrawSubItem(e)
End If
End Sub
End Class
End Namespace

原文来源:“激情燃烧的木炭” http://www.woodcoal.cn/
原文标题:<SPAN style="color:#FF0000">带进度条的ListView,在SubItem中显示Progress</SPAN> - Visual Basic[激情燃烧的

木炭]
原文地址:http://www.woodcoal.cn/technology/visual-basic/200964-23510-781.html

相关文章

Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 --------------------------...
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTime 竟然结果和...
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的解决方案直接...
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,看来我以前没...
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, t...
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integ...