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

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.

使用DrawText的基于点（X，Y） - 作为目前：

如果我改变代码画出长方形，我得到这样的东西，因为一条线可能会被画几次：

你能请给我如何解决这个问题的想法？ 这里是我的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) 

此外，该解决方案是不优雅，但工程。 欢迎留下任何反馈意见。