textbox的高度自适应

tang688 2008-07-12 10:38:56

在VB中使用textbox
multiline=true
当内容有点长时它会换行,但换行多后会看不到内容(我不用滚动条),我想让它自动适应高度.需要如何才能实现?

...全文

342 4 打赏收藏转发到动态举报

写回复

用AI写文章

4 条回复

切换为时间正序

请发表友善的回复…

发表回复

lan563 2008-07-13

打赏
举报

[Quote=引用 3 楼 datou985 的回复:]
标记一下，以便查阅
[/Quote]

datou985 2008-07-13

打赏
举报

标记一下，以便查阅

yachong 2008-07-12

打赏
举报

happy_sea 2008-07-12

打赏
举报

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