Question

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

正如您在下面的OnPain方法中所看到的，绘制文本的位置基于点（x，y）。这样可以正常工作，直到文本超出控件的水平边界。

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

Line 1 is Bold Line 2 is Regular Line 3 is both Bold and Regular (drawn 3 times) Line 4 is a biiiiiig line with Bold 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.

使用基于点（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)

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

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

1 个答案: