已实现text自适应高度，现在怎么加上自适应宽度
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 = &HBA
Private Const WM_GETFONT = &H31
Private Const EM_GETRECT = &HB2
Private Type 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 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 TEXTMETRIC) As Long
Private Sub Text1_Change()
With Text1
Dim dc As Long, tm As TEXTMETRIC, oft As Long, rct As RECT
dc = GetDC(.hwnd)
oft = SelectObject(dc, SendMessage(.hwnd, WM_GETFONT, 0&, ByVal 0&))
GetTextMetrics dc, tm
SelectObject dc, oft
ReleaseDC .hwnd, dc
SendMessage .hwnd, EM_GETRECT, 0&, rct
.Height = Me.ScaleY((tm.tmHeight) * SendMessage(.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&) + 6, vbPixels, Me.ScaleMode)
End With
End Sub
--------------------编程问答--------------------
用 DrawText 就可以得到宽和高。
Option Explicit
Private Sub Text1_Change()
Dim hDC As Long
Dim hFont As Long
Dim rcText As RECT
With Text1
hDC = GetDC(.hwnd)
hFont = SelectObject(hDC, SendMessage(.hwnd, WM_GETFONT, 0&, ByVal 0&))
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
补充：VB , 基础类
