Imports
System.Drawing
Public Class MyListBox Class MyListBox
Inherits System.Windows.Forms.ListBox
构造函数#Region "构造函数"
Public Sub New()Sub New()
MyBase.New()
' 此调用是 Windows 窗体设计器所必需的。
InitializeComponent()
' 在 InitializeComponent() 调用之后添加任何初始化。
Me.DrawMode = Windows.Forms.DrawMode.OwnerDrawVariable
End Sub
#End Region
重画每一项#Region "重画每一项"
Private Sub MyListBox_DrawItem()Sub MyListBox_DrawItem(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles Me.DrawItem
Dim txtBrush As SolidBrush = New SolidBrush(Color.Blue), bgBrush As SolidBrush = New SolidBrush(Color.LightCyan)
Dim txtFnt As Font = New Font(Me.Font.Name, Me.Font.Size)
Try
If e.Index = -1 Then Exit Sub
If e.Index Mod 2 = 0 Then txtBrush = New SolidBrush(Color.Red)
If e.State And System.Windows.Forms.DrawItemState.Selected Then
txtFnt = New Font(Me.Font.Name, Me.Font.Size, FontStyle.Italic Or FontStyle.Bold)
bgBrush = New SolidBrush(Color.LightSteelBlue)
End If
e.Graphics.FillRectangle(bgBrush, e.Bounds)
Dim R As New RectangleF(e.Bounds.X, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
Dim SF As New StringFormat : SF.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(" " + Items(e.Index).ToString, txtFnt, txtBrush, R, SF)
e.DrawFocusRectangle()
'R = Nothing : SF = Nothing
Catch ex As Exception
'Throw New Exception(ex.Message)
End Try
'释放资源
txtBrush.Dispose() : bgBrush.Dispose() : txtFnt.Dispose()
End Sub
#End Region
获取每一项大小#Region "获取每一项大小"
Private Sub MyListBox_MeasureItem()Sub MyListBox_MeasureItem(ByVal sender As Object, ByVal e As System.Windows.Forms.MeasureItemEventArgs) Handles Me.MeasureItem
Try
Dim S As New Size(Me.Width, 400)
Dim itmSize As SizeF = e.Graphics.MeasureString(Items(e.Index).ToString, Me.Font, S)
e.ItemHeight = itmSize.Height * 2 : e.ItemWidth = itmSize.Width
Catch ex As Exception
'Throw New Exception(ex.Message)
End Try
End Sub
#End Region
End Class
Public Class MyListBox Class MyListBox
Inherits System.Windows.Forms.ListBox
构造函数#Region "构造函数"
Public Sub New()Sub New()
MyBase.New()
' 此调用是 Windows 窗体设计器所必需的。
InitializeComponent()
' 在 InitializeComponent() 调用之后添加任何初始化。
Me.DrawMode = Windows.Forms.DrawMode.OwnerDrawVariable
End Sub
#End Region
重画每一项#Region "重画每一项"
Private Sub MyListBox_DrawItem()Sub MyListBox_DrawItem(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles Me.DrawItem
Dim txtBrush As SolidBrush = New SolidBrush(Color.Blue), bgBrush As SolidBrush = New SolidBrush(Color.LightCyan)
Dim txtFnt As Font = New Font(Me.Font.Name, Me.Font.Size)
Try
If e.Index = -1 Then Exit Sub
If e.Index Mod 2 = 0 Then txtBrush = New SolidBrush(Color.Red)
If e.State And System.Windows.Forms.DrawItemState.Selected Then
txtFnt = New Font(Me.Font.Name, Me.Font.Size, FontStyle.Italic Or FontStyle.Bold)
bgBrush = New SolidBrush(Color.LightSteelBlue)
End If
e.Graphics.FillRectangle(bgBrush, e.Bounds)
Dim R As New RectangleF(e.Bounds.X, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height)
Dim SF As New StringFormat : SF.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(" " + Items(e.Index).ToString, txtFnt, txtBrush, R, SF)
e.DrawFocusRectangle()
'R = Nothing : SF = Nothing
Catch ex As Exception
'Throw New Exception(ex.Message)
End Try
'释放资源
txtBrush.Dispose() : bgBrush.Dispose() : txtFnt.Dispose()
End Sub
#End Region
获取每一项大小#Region "获取每一项大小"
Private Sub MyListBox_MeasureItem()Sub MyListBox_MeasureItem(ByVal sender As Object, ByVal e As System.Windows.Forms.MeasureItemEventArgs) Handles Me.MeasureItem
Try
Dim S As New Size(Me.Width, 400)
Dim itmSize As SizeF = e.Graphics.MeasureString(Items(e.Index).ToString, Me.Font, S)
e.ItemHeight = itmSize.Height * 2 : e.ItemWidth = itmSize.Width
Catch ex As Exception
'Throw New Exception(ex.Message)
End Try
End Sub
#End Region
End Class