Option Explicit 
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 Const EM_GETLINECOUNT=& amp; HBA 
Private Const WM_GETFONT=& amp; H31 
Private Const EM_GETRECT=& amp; HB2 

Private Type the RECT 
Left As Long 
Top As Long 
Right As Long 
Bottom As Long 
End Type 

Private Declare Function SelectObject Lib "gdi32" (ByVal HDC As Long, ByVal hObject As Long) 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 Type the TEXTMETRIC 
TmHeight As Long 
TmAscent As Long 
TmDescent As Long 
TmInternalLeading As Long 
TmExternalLeading As Long 
TmAveCharWidth As Long 
TmMaxCharWidth As Long 
TmWeight As Long 
TmOverhang As Long 
TmDigitizedAspectX As Long 
TmDigitizedAspectY As Long 
TmFirstChar As Byte 
TmLastChar As Byte 
TmDefaultChar As Byte 
TmBreakChar As Byte 
TmItalic As Byte 
TmUnderlined As Byte 
TmStruckOut As Byte 
TmPitchAndFamily As Byte 
TmCharSet As Byte 
End Type 
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal HDC As Long, LPTM As the TEXTMETRIC) As Long 

Private Sub Text1_Change () 
With Text1 
As the TEXTMETRIC, Dim dc As Long, tm, RCT oft As Long As the RECT 
Dc GetDC (. HWND) 
Oft=SelectObject (dc, SendMessage (HWND, WM_GETFONT, 0 & amp; , ByVal 0 & amp;) ) 
GetTextMetrics dc, tm 
SelectObject dc, oft 
ReleaseDC HWND, dc 
SendMessage. The HWND, EM_GETRECT, 0 & amp; RCT, 
. Height=Me. ScaleY (SendMessage (tm) tmHeight) * (the HWND, EM_GETLINECOUNT, 0 & amp; , ByVal 0 & amp;) + 6, vbPixels, Me. ScaleMode) 
End With 
End Sub 

CodePudding user response:

 Option Explicit 

Private Sub Text1_Change () 
Dim hDC As Long 
Dim hFont As Long 
Dim rcText As the RECT 

With Text1 
HDC=GetDC (. HWND) 
HFont=SelectObject (hDC, SendMessage (HWND, WM_GETFONT, 0 & amp; , ByVal 0 & amp;) ) 

DrawText hDC, Text, 1, rcText, DT_CALCRECT Or DT_NOCLIP Or DT_NOPREFIX 

SelectObject hDC, hFont 
ReleaseDC HWND, hDC 

. Width=Me. ScaleX (rcText. Right + 8, vbPixels, Me. ScaleMode) 
. Height=Me. ScaleY (rcText. Bottom + 8, vbPixels, Me. ScaleMode) 
End With 
End Sub