Autosize the richtextbox to display its entire contents
jaYPee
contents in it.
Just like a label control if you have a 3 line paragraph it will
automatically resize the label and display its entire contents and
also a wordwrap.
But I can't see this on richtextbox control.
Stoil Marinov
You can do it with a few API calls. Just note that if the size of the text
(or the font) is large enough, it will cause the size of the RichTextBox to
get larger than the Form containing it.
Here is something to get you started. Step through the code and read the
comments for explanation.
1. Open a new project.
2. Place a RichTextBox1 on the Form
3. Copy the following code to the Form
Option Explicit
Private Declare Function AdjustWindowRect Lib _
"user32" (lpRect As rect, _
ByVal dwStyle As Long, _
ByVal bMenu As Long) As Long
Private Declare Function GetWindowLong Lib _
"user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib _
"user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Declare Function GetClientRect Lib _
"user32" (ByVal hwnd As Long, _
lpRect As rect) As Long
Private Type rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const EM_GETRECT = &HB2
Private Const EM_SETRECT = &HB3
Private Const EM_SCROLLCARET = &HB7
Private Const ES_AUTOHSCROLL = &H80&
Private Const ES_AUTOVSCROLL = &H40&
Private Const ES_CENTER = &H1&
Private Type size
cx As Long
cy As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function GetDC Lib _
"user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib _
"user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib _
"gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As size) As Long
Private Const WM_GETFONT = &H31
Private Sub ResizeRTB(rtb As RichTextBox)
'***********************************************
'Calculates the size of the current text
'in the RichTextBox control pointed by rtb
'and resizes the RTB window and its
'formatting rectangle, so that the entire
'text is visible.
'***********************************************
'NOTE: There are limits to which this routine
'can perform and they are determined by the
'size of the window containing the RTB and the
'size of the RTB font.
'***********************************************
Dim lWidth As Long
Dim lHeight As Long
Dim rc As rect
Dim rcWin As rect
Dim lRetVal As Long
Dim sLines() As String
Dim lCount As Long
Dim lMaxWidth As Long
Dim lM As Long
'Parse the current text in lines
ParseString rtb.Text, sLines(), lCount, vbCrLf
For lM = 1 To lCount
'Get the size of each line of the curent RTB text
'NOTE: We need this size in Pixels, because
' that is what the API functions below
' expect by default.
If Len(sLines(lM)) > 0 Then
StringHeightWidth rtb.hwnd, sLines(lM), lWidth, lHeight, False
'Find the longest line
If lWidth > lMaxWidth Then
lMaxWidth = lWidth
End If
End If
Next
'Set the Rect structure with the size
'of the RTB formatting rectangle
rc.Left = 0
rc.Top = 0
'Calculate the height of the entire text
lHeight = lCount * lHeight
'Adjust for border
If rtb.BorderStyle = rtfFixedSingle Then
lHeight = lHeight + 2
End If
'Adjust for 3D appearence
If rtb.Appearance = rtfThreeD Then
lHeight = lHeight + 4
End If
rc.Right = lMaxWidth
rc.Bottom = lHeight
'Adjust the RTB window size to display its
'entire formatting rectangle within its client area
LSet rcWin = rc
lRetVal = AdjustWindowRect(rcWin, GetWindowLong(rtb.hwnd, GWL_STYLE), 1)
If lRetVal <> 0 Then
'Resize/Reposition the RTB window
'NOTE: Since all dimensions are in Pixels
' we need to set the Form's ScaleMode to
' pixels.
Me.ScaleMode = vbPixels
'Calculate the RTB window height and width
lHeight = rcWin.Bottom '- rcWin.Top
lWidth = rcWin.Right '- rcWin.Left
'Check if it will fit in the current Form size
If lHeight <= Me.ScaleHeight And lWidth < Me.ScaleWidth Then
'Center the RTB within the Form
rtb.Left = (Me.ScaleWidth - lWidth) \ 2
rtb.Top = (Me.ScaleHeight - lHeight) \ 2
'Size the RTB
rtb.Width = lWidth
rtb.Height = lHeight
Else
'RTB window is larger than the Form
rtb.Left = 0
rtb.Top = 0
'Size the RTB
rtb.Width = lWidth
rtb.Height = lHeight
End If
'Set the RTB formatting rectangle to the size
'of the current text
SendMessage rtb.hwnd, EM_SETRECT, 0, rc
End If
End Sub
Private Sub ParseString(sInput As String, sWords() As String, lCount As
Long, sDel As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Parses a delimited input string (sInput) on a single
' delimiter and returns the parsed words back in a
' string array sWords().
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' INPUTS:
' sInput - string to be parsed.
' sDel - Delimiter character.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' OUTPUTS:
' sWords() - dynamic string array containing the parsed words.
'
' lCount - long, returning the number of words parsed
'
' NOTES:
' If this subroutine is passed an empty string, it will
' return a lCount of 0 with one element in sWords().
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim lWordStart As Long
Dim lWordEnd As Long
Dim sTemp As String
Dim lParsedArraySize As Long
Dim lDelLen As Long
' Dim lStartM As Long
' Dim lEndM As Long
Dim lLength As Long
lDelLen = Len(sDel)
lLength = Len(sInput)
If sInput = "" Then
ReDim sWords(1 To 1) As String
lCount = 0
sWords(1) = ""
Exit Sub
End If
lParsedArraySize = 50
ReDim sWords(1 To lParsedArraySize) As String
lWordStart = 1
lCount = 1
Do
lWordEnd = InStr(lWordStart, sInput, sDel)
If lWordEnd = 0 Then
sTemp = Mid$(sInput, lWordStart)
If lCount > lParsedArraySize Then
ReDim Preserve sWords(1 To lCount) As String
End If
sWords(lCount) = sTemp
Exit Do
Else
sTemp = Mid$(sInput, lWordStart, lWordEnd - lWordStart)
'If sTemp <> "" Then
If lCount > lParsedArraySize Then
lParsedArraySize = lParsedArraySize + 50
ReDim Preserve sWords(1 To lParsedArraySize) As String
End If
sWords(lCount) = sTemp
lCount = lCount + 1
'End If
lWordStart = lWordEnd + lDelLen
End If
Loop
If lCount < lParsedArraySize Then
ReDim Preserve sWords(1 To lCount) As String
End If
End Sub
Private Sub ScrollEntireTextInView(rtb As RichTextBox)
Dim lOldPos As Long
With rtb
'Remember current caret position
lOldPos = .SelStart
'Move caret to the beginning
.SelStart = 0
'Scroll text so that the caret is visible
SendMessage .hwnd, EM_SCROLLCARET, 0, ByVal 0&
'Restrore caret position
.SelStart = lOldPos
End With
End Sub
Public Sub StringHeightWidth(hwnd As Long, sInput As String, lWidth As Long,
lHight As Long, Optional bTwips As Boolean = True)
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Finds the width and height (in TWIPS) of the string '
'contained in sInput. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' INPUT: '
' hWnd - handle to the window '
' '
' sInput - string, which size is to be found '
'
' bTwips - boolean, default is TRUE. '
' Determines the units in which the '
' text size is returned. Deafult is '
' TWIPS. To get the size back in '
' Pixels, set this parameter to FALSE'
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' OUTPUT: '
' lWidth -long, width of the string in Pixels '
' lHeight-long, height of the string in Pixels'
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim hdc As Long
Dim OldFont As Long
Dim ObjFont As Long
Dim lTemp As Long
Dim CharSize As size
'Get the Window's font
ObjFont = SendMessage(hwnd, WM_GETFONT, 0, 0&)
'Get a Device context
hdc = GetDC(0&)
'Select the Window's font into the device context
OldFont = SelectObject(hdc, ObjFont)
'Get the string's metrics
lTemp = GetTextExtentPoint32(hdc, sInput, Len(sInput), CharSize)
If bTwips Then
'Convert to TWIPS
lWidth = CharSize.cx * Screen.TwipsPerPixelX
lHight = CharSize.cy * Screen.TwipsPerPixelY
Else
'Return in Pixels
lWidth = CharSize.cx
lHight = CharSize.cy
End If
'Clean up
lTemp = SelectObject(hdc, OldFont)
lTemp = ReleaseDC(0&, hdc)
End Sub
Private Sub Form_Load()
Dim lRetVal As Long
'Disable autoscroll in the RTB.
lRetVal = GetWindowLong(RichTextBox1.hwnd, GWL_STYLE)
lRetVal = (lRetVal And (Not ES_AUTOHSCROLL)) 'lRetVal And ES_AUTOHSCROLL
lRetVal = (lRetVal And (Not ES_AUTOVSCROLL)) 'lRetVal And
ES_AUTOVSCROLL
lRetVal = (lRetVal Or ES_CENTER)
lRetVal = SetWindowLong(RichTextBox1.hwnd, GWL_STYLE, lRetVal)
'Resize to fir the current text
ResizeRTB RichTextBox1
End Sub
Private Sub RichTextBox1_Change()
ResizeRTB RichTextBox1
'Scroll text in view
ScrollEntireTextInView RichTextBox1
End Sub
4. Run the project. The RTB is shown centered in the Form and sized to fit
its default text. Start typing/deleting text in the RTB and see how its size
changes to accommodate the new text size.
Regards,
Stoil
"jaYPee" <jpee...@mailops.com> wrote in message
news:11t3ot063haoikdsc...@4ax.com...
jaYPee
Thank you,
jaYPee