VB.NET Graphics.DrawString调整字体大小以适应带有自动换行的容器

时间:2015-11-21 17:33:11

标签: vb.net

我从MSDN中获取以下示例并将其转换为VB。然后调整它以尝试考虑容器的高度以允许自动换行。

public Font GetAdjustedFont(Graphics GraphicRef, string GraphicString, Font OriginalFont, int ContainerWidth, int MaxFontSize, int MinFontSize, bool SmallestOnFail)
{
// We utilize MeasureString which we get via a control instance           
for (int AdjustedSize = MaxFontSize; AdjustedSize >= MinFontSize; AdjustedSize--)
{
  Font TestFont = new Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style);

  // Test the string with the new size
  SizeF AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont);

  if (ContainerWidth > Convert.ToInt32(AdjustedSizeNew.Width))
  {
// Good font, return it
     return TestFont;
  }
}

// If you get here there was no fontsize that worked
// return MinimumSize or Original?
if (SmallestOnFail)
{
  return new Font(OriginalFont.Name,MinFontSize,OriginalFont.Style);
}
else
{
  return OriginalFont;
}
}

这就是我所拥有的:

Protected Overrides Sub OnPaint(e As PaintEventArgs)
    MyBase.OnPaint(e)

    Dim drawFont As New System.Drawing.Font(SystemFonts.DefaultFont.Name, 16)
    Dim drawBrush As New System.Drawing.SolidBrush(Me.ForeColor)
    Dim drawFormat As New System.Drawing.StringFormat

    drawFont = GetAdjustedFont(e.Graphics, noticeText, drawFont, RectangleF.op_Implicit(ClientRectangle), 40, 8, True)

    e.Graphics.DrawString(noticeText, drawFont, drawBrush, RectangleF.op_Implicit(ClientRectangle))

    drawFont.Dispose()
    drawBrush.Dispose()

End Sub

Public Function GetAdjustedFont(ByRef GraphicRef As Graphics, ByVal GraphicString As String, ByVal OriginalFont As Font, ByVal ContainerSize As RectangleF, ByVal MaxFontSize As Integer, ByVal MinFontSize As Integer, ByVal SmallestOnFail As Boolean) As Font

    ' We utilize MeasureString which we get via a control instance           
    For AdjustedSize As Integer = MaxFontSize To MinFontSize Step -1

        Dim TestFont = New Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style)

        ' Test the string with the new size
        Dim AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont, ContainerSize.Size)

        If ContainerSize.Width > Convert.ToInt32(AdjustedSizeNew.Width) Then
            If ContainerSize.Height > Convert.ToInt32(AdjustedSizeNew.Height) Then
                ' Good font, return it
                Return TestFont
            End If
        End If
    Next

    ' If you get here there was no fontsize that worked
    ' return MinimumSize or Original?
    If SmallestOnFail Then
        Return New Font(OriginalFont.Name, MinFontSize, OriginalFont.Style)
    Else
        Return OriginalFont
    End If
End Function

ClientRectangle是456宽,48高。我正在尝试打印的文本是“这是一个测试字符串,用于查看应用程序调整其文本以适应控件的程度。”该字体的大小为28,我只能看到“这是一个要查看的测试字符串”。

我希望它包装文本并使用允许显示所有文本的最大字体,但我很难弄清楚如何实现它。

2 个答案:

答案 0 :(得分:1)

我设法让它发挥作用。我没有将打印字符串的宽度和高度与容器进行比较,而是检查MeasureString是否能够适合所有字符。在测量字符串时,我不得不减小绘图矩形的高度,因为底线的一半被剪切了较长的字符串。

Protected Overrides Sub OnPaint(e As PaintEventArgs)
    MyBase.OnPaint(e)

    Dim drawFont As New System.Drawing.Font(SystemFonts.DefaultFont.Name, 16)
    Dim drawBrush As New System.Drawing.SolidBrush(Me.ForeColor)
    Dim drawFormat As New System.Drawing.StringFormat

    Dim drawRect As New RectangleF(e.ClipRectangle.Location, e.ClipRectangle.Size)
    drawRect = New RectangleF(New Drawing.PointF(0, 0), Me.ClientRectangle.Size)
    drawRect.Height = drawRect.Height * 0.65 'The bottom line of text was getting partially clipped, so reduced the height of the drawing area to 65%

    drawFont = GetAdjustedFont(e.Graphics, noticeText, drawFont, drawRect, 40, 4, True)

    e.Graphics.DrawString(noticeText, drawFont, drawBrush, RectangleF.op_Implicit(ClientRectangle))

    drawFont.Dispose()
    drawBrush.Dispose()

End Sub

Public Function GetAdjustedFont(ByRef GraphicRef As Graphics, ByVal GraphicString As String, ByVal OriginalFont As Font, ByVal ContainerSize As RectangleF, ByVal MaxFontSize As Integer, ByVal MinFontSize As Integer, ByVal SmallestOnFail As Boolean) As Font

    'Loop through font sizes and MeasureString to find the largest font which can be used         
    For AdjustedSize As Integer = MaxFontSize To MinFontSize Step -1

        Dim TestFont = New Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style)
        Dim charsFitted As Integer
        Dim linesFilled As Integer

        ' Test the string with the new size
        Dim AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont, ContainerSize.Size, New StringFormat, charsFitted, linesFilled)

        If charsFitted = GraphicString.Length Then 'If every characted in the string was printed
            'Good font, return it
            Return TestFont
        End If

    Next

    ' If you get here there was no fontsize that worked
    ' return MinimumSize or Original?
    If SmallestOnFail Then
        Return New Font(OriginalFont.Name, MinFontSize, OriginalFont.Style)
    Else
        Return OriginalFont
    End If
End Function

答案 1 :(得分:0)

感谢您提供这个出色的解决方案!

一点延伸: 当你只想要一个oneliner更改你的" Good Font If-Clause" =>

If charsFitted = GraphicString.Length And linesFilled = 1 Then
     Return TestFont
End If
相关问题