ラベルコントロールを拡張してテキストの太字部分を表示する

Question

html "b"タグに基づいて太字セグメントを表示するために、ラベルコントロール（winforms）を拡張しようとしています。

下記のOnPainメソッドからわかるように、テキストが描かれる場所はポイント（x、y）に基づいています。これは、テキストがコントロールの水平境界を超えるまでうまく動作します。

例 - Iは、ラベルテキストとしてこれを設定した場合：点（x、y）に基づいのDrawTextを使用

<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.

- 現在とおり

私は、コードを変更する場合代わりに矩形を描画すると、1行で何度も描画することができるため、次のようになります。

これを解決する方法を私に教えてください。 ここに私の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) 

ここでも、解決策は、エレガントではありませんが、動作します。 フィードバックをお寄せください。