VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 能自行调节高度的 TextBox
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:11884, 日期:2001-02-09
能自行调节高度的 TextBox
Ken J

概述
TextBox 在放到 Form 中以后, 就不管内容有多少, 就是占这么多的地盘, 为什么不让它灵活一些呢?

每当TextBox 的内容修改好以后, 就查看TextBox 的行数是否变化。 如果有改变的话, 就把TextBox 的位置调整到合适的位置。

一个可能的应用就是在TextBox 和MsFlexGrid 配合使用的情况, 可以动态修改高度。

实现步骤
1 开启一个新的工程。

2 增加一个TextBox(Text1), 修改BorderStyle 为0-None, MultiLine 为 True。

3 在 Form1 的声明中增加:

Const EM_GETLINECOUNT = &HBA

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim LastLine As Long 注释:最后的行数
Dim LineHeight       注释:每行的高度

4 在 Form_Load 过程中增加:

Private Sub Form_Load()
Set Me.Font = Text1.Font
LineHeight = Me.TextHeight("TT")
End Sub

5 在 Text1_Change 中增加代码:

Private Sub Text1_Change()
Dim Ret As Long
Ret = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&) 注释:取行数
If Ret <> LastLine Then
If Text1.Height + Text1.Top + LineHeight > Me.ScaleHeight And Ret > 1 Then
If LastLine <= Ret - 1 Then
Exit Sub 注释:如果已经是最大高度,保持
End If
LastLine = Ret - 1 注释:超过最大高度
Else
LastLine = Ret
End If
Text1.Height = LastLine * LineHeight 注释:修改高度
End If
End Sub

6 在Text1_GotFocus 中增加代码:

Private Sub Text1_GotFocus()
LastLine = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
End Sub

7 按F5, 开始运行。 在 TextBox 中多打入几行, 可以发现TextBox 的高度会自动修改, 甚至对剪贴操作也一样有效。 而在 TextBox 到了Form 的最大边缘后, 就停止了扩张高度。