Thanks to the wonderful users on The Code Project (Specifically
Kschuler[
^]), I was able to create a fairly simple program to resize the text in a
RichTextBox
to completely fill the Rich Text Box with text. This would be the polar opposite of the
AutoSize
property. Instead of making the control larger or smaller to fit the text, the text is fitted to the size of the control.
If the text is too long to fit, the font is made smaller, if it is too small the font size is increased. Actually, we are not adjusting the font size, but the
ZoomFactor
property of the
RichTextBox
.
To use the below code, create a
RichTextBox
object (
RichTextBox1
) and a button (
Button1
). Fill the
RichTextBox
with text and run the program. Hitting
Button1
will cause the text to be adjusted.
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Integer) As Integer
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Integer) As Integer
Public Const GWL_STYLE As Integer = (-16)
Public Const WS_VSCROLL As Integer = &H200000
Public Const WS_HSCROLL As Integer = &H100000
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
RichTextBox1.SelectAll()
RichTextBox1.SelectionAlignment = HorizontalAlignment.Center
Dim bVScrollBar As Boolean
bVScrollBar = ((GetWindowLong(Me.RichTextBox1.Handle, GWL_STYLE) And WS_VSCROLL) = WS_VSCROLL)
Select Case bVScrollBar
Case True
Do
RichTextBox1.ZoomFactor = RichTextBox1.ZoomFactor - 0.01
bVScrollBar = ((GetWindowLong(Me.RichTextBox1.Handle, GWL_STYLE) And WS_VSCROLL) = WS_VSCROLL)
If bVScrollBar = False Then Exit Do
Loop
Case False
Do
RichTextBox1.ZoomFactor = RichTextBox1.ZoomFactor + 0.01
bVScrollBar = ((GetWindowLong(Me.RichTextBox1.Handle, GWL_STYLE) And WS_VSCROLL) = WS_VSCROLL)
If bVScrollBar = True Then
Do
RichTextBox1.ZoomFactor = RichTextBox1.ZoomFactor - 0.01
bVScrollBar = ((GetWindowLong(Me.RichTextBox1.Handle, GWL_STYLE) And WS_VSCROLL) = WS_VSCROLL)
If bVScrollBar = False Then Exit Do
Loop
Exit Do
End If
Loop
End Select
End Sub