Public Class Form1
Inherits System.Windows.Forms.Form
#Region " Windows 窗体设计器生成的代码 "
Public Sub New()
MyBase.New()
'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加任何初始化
End Sub
'窗体重写处置以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Windows 窗体设计器所必需的
Public components As System.ComponentModel.IContainer
'注意:以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
Friend WithEvents Text1 As System.Windows.Forms.TextBox
<System.Diagnostics.DebuggerStepThrough()> Public Sub InitializeComponent()
Me.Text1 = New System.Windows.Forms.TextBox()
Me.SuspendLayout()
'
'Text1
'
Me.Text1.Location = New System.Drawing.Point(68, 50)
Me.Text1.Multiline = True
Me.Text1.Name = "Text1"
Me.Text1.Size = New System.Drawing.Size(100, 113)
Me.Text1.TabIndex = 0
Me.Text1.Text = "TextBox1"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(292, 273)
Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Text1})
Me.Name = "Form1"
Me.Text = "Form1"
Me.ResumeLayout(False)
End Sub
#End Region
Public Sub Text1_Change(ByVal sender As Object, ByVal e As System.EventArgs) Handles Text1.TextChanged
With Text1
Dim dc As Integer, tm As TEXTMETRIC, oft As Integer, rct As RECT
dc = GetDC(.Handle.ToInt32)
oft = SelectObject(dc, SendMessage(.Handle.ToInt32, WM_GETFONT, 0&, 0&))
GetTextMetrics(dc, tm)
SelectObject(dc, oft)
ReleaseDC(.Handle.ToInt32, dc)
SendMessage(.Handle.ToInt32, EM_GETRECT, 0&, rct)
'.Height = Me.Scale((tm.tmHeight) * SendMessage(.Handle.ToInt32, EM_GETLINECOUNT, 0&, 0&) + 6, System.Drawing.GraphicsUnit.Pixel, Me.ScaleMode)
.Height = tm.tmHeight * SendMessage(.Handle.ToInt32, EM_GETLINECOUNT, 0&, 0&) + 6
End With
End Sub
End Class
Public Module APIFunction
'随着文本内容自动调整高度的文本框
'窗体上需要有一个名为Text1的文本框
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Integer) As Integer
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As RECT) As Integer
Public Const EM_GETLINECOUNT = &HBA
Public Const WM_GETFONT = &H31
Public Const EM_GETRECT = &HB2
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Integer) As Integer
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
Public Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Integer, ByRef lptm As TEXTMETRIC) As Integer
End Module
Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Public Structure TEXTMETRIC
Public tmHeight As Integer
Public tmAscent As Integer
Public tmDescent As Integer
Public tmInternalLeading As Integer
Public tmExternalLeading As Integer
Public tmAveCharWidth As Integer
Public tmMaxCharWidth As Integer
Public tmWeight As Integer
Public tmOverhang As Integer
Public tmDigitizedAspectX As Integer
Public tmDigitizedAspectY As Integer
Public tmFirstChar As Byte
Public tmLastChar As Byte
Public tmDefaultChar As Byte
Public tmBreakChar As Byte
Public tmItalic As Byte
Public tmUnderlined As Byte
Public tmStruckOut As Byte
Public tmPitchAndFamily As Byte
Public tmCharSet As Byte
End Structure