Question

该类继承System.Windows.Forms.Label（此控件的最佳功能集）。

控件的大小由基类的AutoSize属性设置（必须足够），但是DrawString绘制的宽度还是变窄，取决于所使用的字体。对于大字体，高度也可能是错误的。

我认为Ladel和Graphics使用不同的渲染模式，但无法理解这种差异。

还是代码有问题？

Public Class LabelProgressBar
    Inherits Label

    Private dProgress As Double = 0.0
    Private nBackAlpha As Byte = 64
    Private stBarColor0 As Color = Color.Maroon
    Private stBarColor1 As Color = Color.ForestGreen

    Public Property BackAlpha As Byte
        Get
            Return nBackAlpha
        End Get
        Set(value As Byte)
            If value <> nBackAlpha Then
                nBackAlpha = value
                Invalidate()
            End If
        End Set
    End Property

    Public Property BarColor0 As Color
        Get
            Return stBarColor0
        End Get
        Set(value As Color)
            If value <> stBarColor0 Then
                stBarColor0 = value
                Invalidate()
            End If
        End Set
    End Property

    Public Property BarColor1 As Color
        Get
            Return stBarColor1
        End Get
        Set(value As Color)
            If value <> stBarColor1 Then
                stBarColor1 = value
                Invalidate()
            End If
        End Set
    End Property

    Public Property Progress As Double
        Get
            Return dProgress
        End Get
        Set(value As Double)
            If value <> dProgress Then
                Dim fOld = InnerProgress
                dProgress = value
                If InnerProgress <> fOld Then Invalidate()
            End If
        End Set
    End Property

    Private ReadOnly Property InnerProgress As Single
        Get
            If dProgress < 0.0 Then Return 0.0
            If dProgress > 1.0 Then Return 1.0
            Return CSng(Progress)
        End Get
    End Property

    Private Sub LabelProgressBar_PaddingChanged(sender As Object, e As EventArgs) Handles Me.PaddingChanged
        Invalidate()
    End Sub

    Private Sub LabelProgressBar_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        If Width - Padding.Left - Padding.Right > 0 AndAlso Height - Padding.Top - Padding.Bottom > 0 Then
            e.Graphics.CompositingQuality = CompositingQuality.HighQuality
            e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
            e.Graphics.Clear(BackColor)
            PaintGradient(e.Graphics, e.ClipRectangle, 1.0, nBackAlpha)
            PaintGradient(e.Graphics, e.ClipRectangle, InnerProgress, 255)
            Dim stNonPadded = New RectangleF(e.ClipRectangle.Location, e.ClipRectangle.Size)
            stNonPadded.X = Padding.Left
            stNonPadded.Width -= Padding.Left + Padding.Right
            stNonPadded.Y = Padding.Top
            stNonPadded.Height -= Padding.Top + Padding.Bottom
            Using objBrush = New SolidBrush(ForeColor)
                Using objFormat = New StringFormat()
                    Select Case TextAlign
                        Case ContentAlignment.TopLeft, ContentAlignment.MiddleLeft, ContentAlignment.BottomLeft
                            objFormat.Alignment = StringAlignment.Near
                        Case ContentAlignment.TopCenter, ContentAlignment.MiddleCenter, ContentAlignment.BottomCenter
                            objFormat.Alignment = StringAlignment.Center
                        Case Else
                            objFormat.Alignment = StringAlignment.Far
                    End Select
                    objFormat.Trimming = If(AutoEllipsis, StringTrimming.EllipsisWord, StringTrimming.Character)
                    Select Case TextAlign
                        Case ContentAlignment.MiddleLeft, ContentAlignment.MiddleCenter, ContentAlignment.MiddleRight
                            Dim stDrawSize = e.Graphics.MeasureString(Text, Font, stNonPadded.Size, objFormat)
                            stNonPadded.Y += (stNonPadded.Height - stDrawSize.Height) / 2
                        Case ContentAlignment.BottomLeft, ContentAlignment.BottomCenter, ContentAlignment.BottomRight
                            Dim stDrawSize = e.Graphics.MeasureString(Text, Font, stNonPadded.Size, objFormat)
                            stNonPadded.Y += stNonPadded.Height - stDrawSize.Height
                    End Select
                    e.Graphics.DrawString(Text, Font, objBrush, stNonPadded, objFormat)
                End Using
            End Using
        End If
    End Sub

    Private Sub LabelProgressBar_TextAlignChanged(sender As Object, e As EventArgs) Handles Me.TextAlignChanged
        Invalidate()
    End Sub

    Private Sub PaintGradient(surface As Graphics, bounds As Rectangle, progress As Single, alpha As Byte)
        Dim stColor0 = Color.FromArgb(alpha, stBarColor0)
        Dim stColor1 = Color.FromArgb(alpha, stBarColor1)
        Using objBrush = New LinearGradientBrush(bounds, stColor0, stColor1, LinearGradientMode.Horizontal)
            surface.FillRectangle(objBrush, New RectangleF(bounds.Left, bounds.Top, bounds.Width * progress, bounds.Height))
        End Using
    End Sub

End Class

Answer 1

为什么不让标签为您做抽绳工作？

Protected Overrides Sub OnPaintBackground(e As PaintEventArgs)
    MyBase.OnPaintBackground(e)
    If Width - Padding.Left - Padding.Right > 0 AndAlso Height - Padding.Top - Padding.Bottom > 0 Then
        e.Graphics.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
        e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
        e.Graphics.Clear(BackColor)
        PaintGradient(e.Graphics, e.ClipRectangle, 1.0, nBackAlpha)
        PaintGradient(e.Graphics, e.ClipRectangle, InnerProgress, 255)
    End If
End Sub

MeasureString / DrawString比您预期的要复杂一些。当使用带有矩形参数的DrawString时，我可以看到最后一个字符蜂被剥离（未渲染）。您可以使用此行来避免这种情况

e.Graphics.DrawString(Text, Font, objBrush, stNonPadded.Location, objFormat)

但是我不确定这是否是您的问题，因为您的描述不太清楚。

根据ClipRectangle对齐也不是一个好主意，因为在窗体移动，隐藏，部分隐藏，移出屏幕等等时，它可能占控件的一半。

Paint的处理程序中的文本呈现大小错误

1 个答案: