Private Const LF_FACESIZE = 32
Private Const LF_FULLFACESIZE = 64
Private Const WM_GETFONT = &H31
Private Const WM_USER = &H400
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETLINE = &HC4
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBB
Private Const EM_GETRECT = &HB2
Private Const EM_GETCHARFORMAT = (WM_USER + 58)
Private Const SCF_SELECTION = &H1
Private Type CHARFORMAT
cbSize As Long
dwMask As Long
dwEffects As Long
yHeight As Long
yOffset As Long
crTextColor As Long
bCharSet As Byte
bPitchAndFamily As Byte
szFaceName(LF_FACESIZE) As String
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Any, LParam As Any) As Long
Private Sub Form_Load()
Dim nLine As Long
Dim nIndex As Long
Dim nCurrentPos As Long
Dim nTextsize As Long
Dim cf As CHARFORMAT
Dim nLineCount As Long
rtfScripts.Text = "This is a test... This is a test... This is a test... This is a test... This is a test... This is a test... This is a test... This is a test..."
nLineCount = SendMessage(rtfScripts.hwnd, EM_GETLINECOUNT, ByVal 0&, ByVal 0&)
For nLine = 0 To (nLineCount - 1) Step 1
rtfScripts.SelStart = nCurrentPos
nIndex = SendMessage(rtfScripts.hwnd, EM_LINEINDEX, nLine, ByVal 0&)
nCurrentPos = nCurrentPos + SendMessage(rtfScripts.hwnd, EM_LINELENGTH, nIndex, ByVal 0&)
rtfScripts.SelLength = nCurrentPos
SendMessage rtfScripts.hwnd, EM_GETCHARFORMAT, SCF_SELECTION, cf
nTextsize = nTextsize + cf.yHeight
Next nLine
rtfScripts.Height = nTextsize + 10
End Sub
