Visual Studio:设置文本框宽度,给定monspace字体和MaxLength

这是一个“答案”,因为对我来说它似乎效果最好,但我不会称之为“正确答案”,因为它有点代码密集型。我对以下所有方面感到失望:

Graphics.MeasureString()
TextRenderer.MeaureText()
Graphics.MeasureCharacterRanges()

我一直在尝试合成质量(CompositingQuality)、文本渲染提示(TextRenderingHint)和平滑模式(SmoothingMode),直到我脸色发青。对于不同的字体大小、单位和字体,这些方法似乎都不能产生一致的结果 重要的是 ,用户的小、中或大文本的Windows显示设置。

估计 文本的宽度,但控件中呈现的文本的方式不同。因此,如果这是真的,那么使用绘制的文本来估计控件中文本的宽度永远无法完美工作。我本以为微软会很容易做到这一点 ,我可能错了,但从我观察到的情况来看,微软还没有做对。

下面是我发现的代码,无论windows设置、字体单位或与图形对象有关的任何内容,都能非常准确地工作。它创建一个不可见的多行文本框,然后将其宽度属性一次缩小一个像素,直到强制文本换行,并记录结果宽度。

要使用此代码:

• 调用ResizeControlForFont以根据预设字体适当调整文本框或组合框的大小。
• 如果要一步调整控件的字体大小和宽度,请调用SetFontSizeAndResizeControl。

Public Sub ResizeControlForFont(ByVal Cont As Control, Optional ByVal WidthInCharacters As Integer = 0)
    'This for single or multiline textboxes and comboboxes.
    'A MONOSPACED font must first be assigned to the control before calling this. 
    'If you prefer to do it in a single step, call SetFontSizeAndResizeControl, which will call this procedure.
    'If WidthInCharacters is not specified, it will use the MaxLength property of the control, if possible.
    'For multiline textboxes, ALWAYS specify the number of columns desired when calling this procedure. You don't want to use the MaxLength property of a multiline textbox.
    Dim CharacterWidth As Single = GetWidthOfCharacter(Cont.Font)
    Dim AddedWidth As Integer = (CharacterWidth * 0.3) + 2 'I've chosen 30% of a character's width plus 2 pixels and I like the results.
    'If not supplied, use the MaxLength property if available and appropriate.
    If WidthInCharacters = 0 Then
        If TypeOf Cont Is TextBox Then
            Dim tmpItem As TextBox = Cont
            If tmpItem.Multiline = False Then
                'Don't do this for multiline textboxes.
                WidthInCharacters = tmpItem.MaxLength
            End If
        ElseIf TypeOf Cont Is ComboBox Then
            Dim tmpItem As ComboBox = Cont
            WidthInCharacters = tmpItem.MaxLength
        End If
    End If
    If TypeOf Cont Is TextBox Then
        'For multiline textboxes, Always specify the number of columns desired.
        Dim tmpItem As TextBox = Cont
        If tmpItem.Multiline = True Then
            'Only do this for multiline textboxes.
            AddedWidth = AddedWidth + SystemInformation.VerticalScrollBarWidth
        End If
    ElseIf TypeOf Cont Is ComboBox Then
        Dim tmpItem As ComboBox = Cont
        AddedWidth = AddedWidth + SystemInformation.VerticalScrollBarWidth
    End If
    Cont.Width = (WidthInCharacters * CharacterWidth) + AddedWidth

End Sub

Public Sub SetFontSizeAndResizeControl(ByVal Cont As Control, ByVal NewFontSize As Single, Optional ByVal WidthInCharacters As Integer = 0)
    'Sets the font size and resizes it in one step.
    Cont.Font = New Font(Cont.Font.Name, NewFontSize, Cont.Font.Style, Cont.Font.Unit, Cont.Font.GdiCharSet, Cont.Font.GdiVerticalFont)
    Call ResizeControlForFont(Cont, WidthInCharacters)
End Sub

Public Function GetWidthOfCharacter(ByVal CtrlFont As Font) As Single
    Static LastResult As Single
    Static LastCtrlFont As Font
    'OPTIMIZING.  Don't repeat what you don't have to.
    'Sending the same font to this function twice in a row will skip the test and return the last result.
    'To take advantage of this, resize all controls with the same font and size all together.
    If Not LastCtrlFont Is Nothing Then
        If CtrlFont.Name = LastCtrlFont.Name And CtrlFont.Size = LastCtrlFont.Size And CtrlFont.Style = LastCtrlFont.Style And CtrlFont.GdiCharSet = LastCtrlFont.GdiCharSet And CtrlFont.GdiVerticalFont = LastCtrlFont.GdiVerticalFont Then
            Return LastResult 'Speeds things up if the same font was used last time.  Useful when sizing many controls with the same font.
            Exit Function
        End If
    End If
    Dim TinyString As String = StrDup(51, "W") 'Two strings of aribitrary length, ample for the precision we need.
    Dim BigString As String = StrDup(99, "W") '
    Dim tmpTxt As New TextBox 'Temporarily created textbox.
    With tmpTxt
        .Font = CtrlFont
        .Height = .Height * 2.5 'Just ensures it's tall enough to work.
        .Multiline = True
        .ScrollBars = ScrollBars.Vertical
        .Font = CtrlFont

        'Do this twice.  First with TinyString.
        .Width = TextRenderer.MeasureText(TinyString, CtrlFont).Width + SystemInformation.VerticalScrollBarWidth 'Start by making it a little too big using MeasureText
        .Text = TinyString
        Do Until .GetLineFromCharIndex(.TextLength) > 0 Or .Width = SystemInformation.VerticalScrollBarWidth
            .Width = .Width - 1
        Loop
        Dim TinyWidth As Integer = .Width

        'Do it again with BigString.
        .Width = TextRenderer.MeasureText(BigString, CtrlFont).Width + SystemInformation.VerticalScrollBarWidth 'Start by making it a little too big using MeasureText
        .Text = BigString
        Do Until .GetLineFromCharIndex(.TextLength) > 0 Or .Width = SystemInformation.VerticalScrollBarWidth
            .Width = .Width - 1
        Loop
        Dim BigWidth As Integer = .Width

        'We did it twice to isolate the width of characters from width added by padding, borders and the scrollbar.
        'We compare the two results, leaving only a difference in width created by the characters themselves.
        'The Denominator here is the difference in the number of characters.
        LastResult = (BigWidth - TinyWidth) / (Len(BigString) - Len(TinyString))

        LastCtrlFont = CtrlFont 'Remember this so we can skip it if we try the same font again next time
        Return LastResult
    End With
End Function

这是正确的方法吗?嗯,这有点代码密集。但这是我发现的唯一能产生准确一致结果的方法。如果微软有更好的方法,我愿意接受。但我对 图样MeasureString() , 文本渲染器。MeaureText() 和 图样MeasureCharacterRanges()

虽然我是为单行文本框启动的,但它可以与组合框和多行文本框一起使用,在那里它将为下拉按钮或垂直滚动条增加宽度。在后一种情况下,您需要传递所需的列数。在所有情况下,如果不提供字符宽度,它都会使用控件的MaxLength属性。(这对多行文本框不好。)