带有彩色边框的自定义 GroupBox 控件
Custom GroupBox Control with colored border
我找到了这个派生自 GroupBox 的自定义控件,它允许更改其边框的颜色。
我知道代码最初来自 Whosebug,虽然我找不到它。
由于某些原因,在设置GroupBox的Text 属性时,最后一个字母总是被删掉。
任何比我更有经验的人都可以在导致此问题的代码中看到任何内容吗?
Public Class myGroupBox
Inherits GroupBox
Private borderColor As Color
Public Sub New()
MyBase.New
Me.borderColor = Color.Blue
End Sub
Public Property BorderColour() As Color
Get
Return Me.borderColor
End Get
Set(ByVal value As Color)
Me.borderColor = value
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As Size = TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = e.ClipRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me.borderColor, ButtonBorderStyle.Solid)
Dim textRect As Rectangle = e.ClipRectangle
textRect.X = (textRect.X + 6)
textRect.Width = tSize.Width
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub
End Class
不要混合使用 TextRenderer
方法和 Graphics
方法进行字符串测量和绘图。当你有一个图形对象时,你应该使用它。
使用Graphics.MeasureString()
和Graphics.DrawString()
或TextRenderer.MeasureText()
和TextRenderer.DrawText()
。
该代码存在一些问题:
- 使用
TextRenderer.MeasureText
测量文本,但未将当前图形 (IdeviceContext
) 对象传递给方法。
- 它使用
e.ClipRectangle
作为Border的度量:最好使用Control.ClientRectangle
Graphics.DrawString
是用来画文字的,当用别的工具测量的时候
- 边框颜色是硬编码的,因此无法使用 属性Grid
更改
- 它是用
Option Strict Off
构建的
► 注意:这不是框架绘制 GroupBox 边框的方式。我们应该改为绘制线条,否则文本无法呈现透明:因为绘制的文本隐藏了由ControlPaint.DrawBorder
绘制的线条,文字背景不能透明
这是该控件的重新访问版本,其中进行了一些可能在其他情况下有用的调整:
如果您认为文本绘制得太靠近左侧,只需根据需要进行偏移即可。您还可以添加 属性 来定义对齐方式。
- 当您第一次将 GroupBox 放入表单时,边框的颜色设置为
SystemColors.Window
:使用 属性Grid 设置另一种颜色。
Public Class myGroupBox
Inherits GroupBox
Private ReadOnly flags As TextFormatFlags =
TextFormatFlags.Top Or TextFormatFlags.Left Or
TextFormatFlags.LeftAndRightPadding Or TextFormatFlags.EndEllipsis
Private m_BorderColor As Color = SystemColors.Window
Public Property BorderColor As Color
Get
Return m_BorderColor
End Get
Set
m_BorderColor = Value
Me.Invalidate()
If DesignMode Then Me.Parent?.Invalidate(Me.Bounds)
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim midText = TextRenderer.MeasureText(e.Graphics, Text, Font, ClientSize).Height \ 2 + 2
Dim rect = New Rectangle(0, midText, ClientSize.Width, ClientSize.Height - midText)
ControlPaint.DrawBorder(e.Graphics, rect, BorderColor, ButtonBorderStyle.Solid)
Dim textRect = Rectangle.Inflate(ClientRectangle, -4, 0)
TextRenderer.DrawText(e.Graphics, $" {Me.Text} ", Font, textRect, ForeColor, BackColor, flags)
End Sub
End Class
我尝试了 Jimi 的代码并成功 运行 它。但是,当该组框文本为空时,它会出现一个小间隙(边框未完全闭合)。我不是 VB.Net 方面的专家,并且发现很难测试代码。
幸运的是,使用 Ian Barber 发布的原始代码,经过反复试验,通过向文本大小宽度添加一个常量值 (textRect.Width = tSize.Width + 2) 解决了这个问题。
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As SizeF = e.Graphics.MeasureString(Me.Text, Me.Font) 'TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = e.ClipRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me.borderColor, ButtonBorderStyle.Solid)
Dim textRect As Rectangle = e.ClipRectangle
textRect.X = textRect.X + 6
textRect.Width = tSize.Width + 2
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub
我找到了这个派生自 GroupBox 的自定义控件,它允许更改其边框的颜色。
我知道代码最初来自 Whosebug,虽然我找不到它。
由于某些原因,在设置GroupBox的Text 属性时,最后一个字母总是被删掉。
任何比我更有经验的人都可以在导致此问题的代码中看到任何内容吗?
Public Class myGroupBox
Inherits GroupBox
Private borderColor As Color
Public Sub New()
MyBase.New
Me.borderColor = Color.Blue
End Sub
Public Property BorderColour() As Color
Get
Return Me.borderColor
End Get
Set(ByVal value As Color)
Me.borderColor = value
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As Size = TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = e.ClipRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me.borderColor, ButtonBorderStyle.Solid)
Dim textRect As Rectangle = e.ClipRectangle
textRect.X = (textRect.X + 6)
textRect.Width = tSize.Width
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub
End Class
不要混合使用 TextRenderer
方法和 Graphics
方法进行字符串测量和绘图。当你有一个图形对象时,你应该使用它。
使用Graphics.MeasureString()
和Graphics.DrawString()
或TextRenderer.MeasureText()
和TextRenderer.DrawText()
。
该代码存在一些问题:
- 使用
TextRenderer.MeasureText
测量文本,但未将当前图形 (IdeviceContext
) 对象传递给方法。 - 它使用
e.ClipRectangle
作为Border的度量:最好使用Control.ClientRectangle
Graphics.DrawString
是用来画文字的,当用别的工具测量的时候- 边框颜色是硬编码的,因此无法使用 属性Grid 更改
- 它是用
Option Strict Off
构建的
► 注意:这不是框架绘制 GroupBox 边框的方式。我们应该改为绘制线条,否则文本无法呈现透明:因为绘制的文本隐藏了由ControlPaint.DrawBorder
绘制的线条,文字背景不能透明
这是该控件的重新访问版本,其中进行了一些可能在其他情况下有用的调整:
如果您认为文本绘制得太靠近左侧,只需根据需要进行偏移即可。您还可以添加 属性 来定义对齐方式。
- 当您第一次将 GroupBox 放入表单时,边框的颜色设置为
SystemColors.Window
:使用 属性Grid 设置另一种颜色。
Public Class myGroupBox
Inherits GroupBox
Private ReadOnly flags As TextFormatFlags =
TextFormatFlags.Top Or TextFormatFlags.Left Or
TextFormatFlags.LeftAndRightPadding Or TextFormatFlags.EndEllipsis
Private m_BorderColor As Color = SystemColors.Window
Public Property BorderColor As Color
Get
Return m_BorderColor
End Get
Set
m_BorderColor = Value
Me.Invalidate()
If DesignMode Then Me.Parent?.Invalidate(Me.Bounds)
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim midText = TextRenderer.MeasureText(e.Graphics, Text, Font, ClientSize).Height \ 2 + 2
Dim rect = New Rectangle(0, midText, ClientSize.Width, ClientSize.Height - midText)
ControlPaint.DrawBorder(e.Graphics, rect, BorderColor, ButtonBorderStyle.Solid)
Dim textRect = Rectangle.Inflate(ClientRectangle, -4, 0)
TextRenderer.DrawText(e.Graphics, $" {Me.Text} ", Font, textRect, ForeColor, BackColor, flags)
End Sub
End Class
我尝试了 Jimi 的代码并成功 运行 它。但是,当该组框文本为空时,它会出现一个小间隙(边框未完全闭合)。我不是 VB.Net 方面的专家,并且发现很难测试代码。
幸运的是,使用 Ian Barber 发布的原始代码,经过反复试验,通过向文本大小宽度添加一个常量值 (textRect.Width = tSize.Width + 2) 解决了这个问题。
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As SizeF = e.Graphics.MeasureString(Me.Text, Me.Font) 'TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = e.ClipRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me.borderColor, ButtonBorderStyle.Solid)
Dim textRect As Rectangle = e.ClipRectangle
textRect.X = textRect.X + 6
textRect.Width = tSize.Width + 2
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub