扩展标签控件以允许文本中的粗体段

Question

我正在尝试扩展标签控件（winforms）以显示基于 html“b”标签的粗体段。

正如您在下面的 OnPain 方法中所见，绘制文本的位置基于一个点 (x,y)。在文本超出控件的水平边界之前，这可以正常工作。

示例 - 如果我将其设置为标签文本：

<b>Line 1 is Bold</b> Line 2 is Regular Line 3 is both <b>Bold</b> and Regular (drawn 3 times) Line 4 is a biiiiiig line with <b>Bold</b> and regular words that will easily exceed the control bounds and if I use rectangles to determine the bounds I will end up with something like this. Line 5 is a Regular again.

使用基于 point(x,y) 的 DrawText - 目前是：

如果我更改代码以绘制矩形，我会得到类似的结果，因为一条线可能会被绘制多次：

您能告诉我如何解决这个问题吗？ 这是我的 OnPaint 方法：

Protected Overrides Sub OnPaint(e As PaintEventArgs)

    'splitter will contain our <b></b> tags
    Dim parts = Me.Text.Split(Splitters, StringSplitOptions.None)

    If parts.Length > 1 Then
        'we have <b></b> tags- first we need to determine if text should start as bold  
        Dim drawBold As Boolean = False
        If Me.Text.Length > 3 Then
            If Me.Text.Substring(0, 3).ToLower = "<b>" Then
                drawBold = True
            End If
        End If

        Dim textBrush As SolidBrush = Nothing, backBrush As SolidBrush
        Dim textFont As Font = Nothing
        backBrush = New SolidBrush(BackColor)

        'create the box to draw in
        Dim x As Single = Me.Padding.Left
        Dim y As Single = 0F
        Dim h As Single = 0F
        Dim w As Single = 0F
        e.Graphics.FillRectangle(backBrush, Me.ClientRectangle)

        textBrush = New SolidBrush(ForeColor)
        For Each part As String In parts
            Dim box As SizeF = Size.Empty

            'if this bold/notbold piece of text contains linebreaks we will need to split further
            Dim lines = part.Split(LineBreakers, StringSplitOptions.None)
            For i As Integer = 0 To lines.Length - 1

                If i > 0 Then
                    'this as new line, need to reset x
                    box = Size.Empty
                    x = Me.Padding.Left
                    y += h
                End If

                If drawBold Then
                    textFont = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Bold, GraphicsUnit.Point)
                    TextRenderer.DrawText(e.Graphics, lines(i), textFont, New Point(CInt(x), CInt(y)), ForeColor, BackColor, TextFormatFlags.WordBreak)
                    box = e.Graphics.MeasureString(lines(i), textFont)
                Else
                    textFont = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Regular, GraphicsUnit.Point)
                    TextRenderer.DrawText((e.Graphics, lines(i), textFont, New Point(CInt(x), CInt(y)), ForeColor, BackColor, TextFormatFlags.WordBreak)
                    box = e.Graphics.MeasureString(lines(i), textFont)
                End If

                'keep count of x-position
                x += box.Width
                'check if a dimension has grown
                w = Math.Max(w, x)
                h = Math.Max(h, box.Height)
            Next
            drawBold = Not drawBold
            'add extra margin to separate bold and regular text
            x += CSng(4)
        Next

        'final adjustments - control size
        Me.Width = CInt(w)
        Me.Height = CInt(y + h)
        ' clean up
        textBrush.Dispose()
        backBrush.Dispose()
        If textFont IsNot Nothing Then
            textFont.Dispose()
        End If
    Else
        'this text has no tags, let the base event kick in instead
        MyBase.OnPaint(e)
    End If

End Sub

Answer 1

排序！ 该解决方案可能不是很优雅......但有效。基本上，验证行是否超出了控件的边界，如果超出，则逐个字符地测量字符串，直到大小恰到好处。然后从列表中删除原始字符串并用拆分版本（2个字符串）替换它。

分割是通过这个函数完成的：

Private Function breakLongString(g As Drawing.Graphics, ByVal textToBreak As String, ByVal textFont As Font, ByVal sizeLimit As Single, ByVal startingXPosition As Single) As String()

    Dim WidthSoFar As Single
    Dim iChar As Integer = 0
    While iChar < textToBreak.Length - 1
        WidthSoFar = g.MeasureString(textToBreak.Substring(0, iChar), textFont).Width + startingXPosition
        If WidthSoFar >= sizeLimit Then
            Exit While
        Else
            iChar = iChar + 1
        End If
    End While
    'now reverse until we find a " " (blank space) so we dont break a word
    While iChar > 0
        If textToBreak.Substring(iChar, 1) = " " Then
            Exit While
        Else
            iChar = iChar - 1
        End If
    End While

    Dim text1 = Trim(textToBreak.Substring(0, iChar))
    Dim text2 = Trim(textToBreak.Substring(iChar, textToBreak.Length - iChar - 1))

    Return {text1, text2}

End Function

我只需要在 DrawText 方法之前调用这个函数：

textFont = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Regular, GraphicsUnit.Point)

Dim LineWidth = e.Graphics.MeasureString(lines(iLine), textFont).Width + x
Dim BoundsWidth = Me.Parent.Width

If LineWidth > BoundsWidth Then
    'we have a problem as the line width is bigger than the control, need to split even further
    Dim textToBreak As String = lines(iLine)
    'remove this text from the list to add it split (as 2 lines)
    lines.RemoveAt(iLine)
    lines.InsertRange(iLine, breakLongString(e.Graphics, textToBreak, textFont, BoundsWidth, x))
End If

TextRenderer.DrawText(e.Graphics, lines(iLine), textFont, New Point(CInt(x), CInt(y)), ForeColor, BackColor, TextFormatFlags.WordBreak)

同样，该解决方案并不优雅，但有效。 欢迎您留下任何反馈。