擴展標籤控件以允許文本中的粗體段

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) 

此外，該解決方案是不優雅，但工程。 歡迎留下任何反饋意見。