带有彩色边框的自定义 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