📄 m61.htm
字号:
<html>
<head>
<title>VB教程</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<p align="center"><script src="../../1.js"></script></a>
<body bgcolor="#ffffff" leftmargin="5" topmargin="1" marginheight="5" marginwidth="5">
<div align=center>
<table border=0 cellpadding=0 cellspacing=0 width=680 align="center">
<tbody>
<tr>
<td bgcolor=#000000 height=9>
<div align=center class=H1> <font color="#FFFFFF">能自行调节高度的 TextBox</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p align="left"> <br>
</font> 概述 </span></font></p>
<p> TextBox 在放到 Form 中以后，
就不管内容有多少， 就是占这么多的地盘， 为什么不让它灵活一些呢？<br>
<br>
每当TextBox 的内容修改好以后， 就查看TextBox 的行数是否变化。 如果有改变的话， 就把TextBox 的位置调整到合适的位置。<br>
<br>
一个可能的应用就是在TextBox 和MsFlexGrid 配合使用的情况， 可以动态修改高度。</span></font></p>
<h3> <span class="unnamed1">实现步骤</span></font></h3>
<p> <span class="unnamed1">1 开启一个新的工程。</span></font></p>
<p> <span class="unnamed1">2 增加一个TextBox(Text1)，
修改BorderStyle 为0-None， MultiLine 为 True。</span></font></p>
<p> <span class="unnamed1">3 在 Form1 的声明中增加：<br>
<br>
Const EM_GETLINECOUNT = &HBA<br>
<br>
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<br>
<br>
Dim LastLine As Long '最后的行数<br>
Dim LineHeight '每行的高度</span></font></p>
<p> <span class="unnamed1">4 在 Form_Load 过程中增加：<br>
<br>
Private Sub Form_Load()<br>
Set Me.Font = Text1.Font<br>
LineHeight = Me.TextHeight("TT")<br>
End Sub</span></font></p>
<p> <span class="unnamed1">5 在 Text1_Change 中增加代码：<br>
<br>
Private Sub Text1_Change()<br>
Dim Ret As Long<br>
Ret = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&) '取行数<br>
If Ret <> LastLine Then<br>
If Text1.Height + Text1.Top + LineHeight > Me.ScaleHeight And Ret
> 1 Then<br>
If LastLine <= Ret - 1 Then<br>
Exit Sub '如果已经是最大高度，保持<br>
End If<br>
LastLine = Ret - 1 '超过最大高度<br>
Else<br>
LastLine = Ret<br>
End If<br>
Text1.Height = LastLine * LineHeight '修改高度<br>
End If<br>
End Sub</span></font></p>
<p> <span class="unnamed1">6 在Text1_GotFocus 中增加代码：<br>
<br>
Private Sub Text1_GotFocus()<br>
LastLine = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)<br>
End Sub</span></font></p>
<p> <span class="unnamed1">7 按F5， 开始运行。 在 TextBox
中多打入几行， 可以发现TextBox 的高度会自动修改， 甚至对剪贴操作也一样有效。 而在 TextBox 到了Form 的最大边缘后，
就停止了扩张高度。</span></font></p>
<p> </p>
<p align="left"> <br>
</table>
</div>
<p align="center"><a href="../../pian/vb.htm">回首页</a>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -