文本框的宽度不变,而高度随文本的内容的多少而变,如何实现?

Question

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim buf() As String
    Dim hhh As Long
    
    
    If KeyCode = 13 Or KeyCode = 8 Then
    buf = Split(Text1.Text, vbCrLf)
   hhh = UBound(buf) + 2
    Text1.Height = TextHeight("样本") * hhh + 200
    Text1.Refresh
    End IfEnd Sub

Answer 1

思路：
获取文本的行数，
根据字体来获取字高，
Line * Height

Answer 2

VERSION 5.00
Begin VB.Form Form2 
   Caption         =   "Form2"
   ClientHeight    =   4110
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9180
   LinkTopic       =   "Form2"
   ScaleHeight     =   4110
   ScaleWidth      =   9180
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   435
      Left            =   4620
      TabIndex        =   1
      Top             =   1200
      Width           =   1785
   End
   Begin VB.TextBox Text1 
      Height          =   2790
      Left            =   615
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "Form2.frx":0000
      Top             =   465
      Width           =   2175
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Sub Command1_Click()
    TestSub "数据库中具所有有相同字段模式的行的集合。行集合可以代表表格中所有或部分字段。行集合也可以代表由查询或由多个表格", Text1
End SubSub TestSub(ByVal newtext As String, TargetTextbox As TextBox)
    
    Dim MAX As Integer
    Dim buf() As String
    Dim abytes() As Byte
    Dim tmp As String
    Dim i As Long
    Dim mmm As Integer
    Dim old As Integer
    
    tmp = ""
    old = 1
    MAX = TargetTextbox.Width \ TextWidth("A") - 2
    abytes = StrConv(newtext, vbFromUnicode)
    For i = 0 To UBound(abytes)
        If abytes(i) > 127 Then
            i = i + 1
        End If
        mmm = mmm + 1
        If i > 0 Then
        If ((i Mod MAX = 0) Or (((i - 1) Mod MAX = 0) And abytes(i - 1) > 127)) Then
            tmp = tmp + Mid$(newtext, old, mmm - old) + vbCrLf
            old = mmm
        End If
        End If
    Next
    MsgBox tmp
    Text1.Text = tmp
End Sub呵呵，差不多能使
这个问题这么点分不够啊

Answer 3

把过程改一下
Sub TestSub(ByVal newtext As String, TargetTextbox As TextBox)
    
    Dim MAX As Integer
    Dim buf() As String
    Dim abytes() As Byte
    Dim tmp As String
    Dim i As Long
    Dim mmm As Integer
    Dim old As Integer
    Dim lll As Integer
    
    tmp = ""
    old = 1
    lll = 0
    MAX = TargetTextbox.Width \ TextWidth("A") - 2
    abytes = StrConv(newtext, vbFromUnicode)
    For i = 0 To UBound(abytes)
        If abytes(i) > 127 Then
            i = i + 1
        End If
        mmm = mmm + 1
        If i > 0 Then
        If ((i Mod MAX = 0) Or (((i - 1) Mod MAX = 0) And abytes(i - 1) > 127 And i > 1)) Then
            tmp = tmp + Mid$(newtext, old, mmm - old) + vbCrLf
            old = mmm
            lll = lll + 1
        End If
        End If
    Next
    MsgBox tmp
    Text1.Text = tmp
    Text1.Height = (lll + 1) * TextHeight("眼本")
End Sub

Answer 4

新建一个控文件，把我的代码全部copy
看看

Answer 5

这个很简单，你在设计时根据字体先看好只一行时能容纳多少字符（汉字按两个计算）并且文本框的高度和宽度是多少，在程序运行时，
算出要有多少行，再改变控件高度，就可以了。不过你测试长度时候要注意
字符串的长度时用我的函数好了。
Public Function StrLen(index1 As String)
StrLen = LenB(StrConv(index1, vbFromUnicode))
End Function你如果看到文本框在设计时一行文字的高度为200，字符的长度允许为20
那么你给文本赋值时，先测字串的长度
text1.high=200*int(strlen("字符串")/20)+1
text1="字符串"
这样就可以了。

Answer 6

能自行调节高度的 TextBox
Ken J 概述
TextBox 在放到 Form 中以后， 就不管内容有多少， 就是占这么多的地盘， 为什么不让它灵活一些呢？每当TextBox 的内容修改好以后， 就查看TextBox 的行数是否变化。 如果有改变的话， 就把TextBox 的位置调整到合适的位置。一个可能的应用就是在TextBox 和MsFlexGrid 配合使用的情况， 可以动态修改高度。实现步骤
1 开启一个新的工程。2 增加一个TextBox(Text1)， 修改BorderStyle 为0-None， MultiLine 为 True。3 在 Form1 的声明中增加：Const EM_GETLINECOUNT = &HBAPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim LastLine As Long 注释：最后的行数
Dim LineHeight       注释：每行的高度4 在 Form_Load 过程中增加：Private Sub Form_Load()
Set Me.Font = Text1.Font
LineHeight = Me.TextHeight("TT")
End Sub5 在 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 Sub6 在Text1_GotFocus 中增加代码：Private Sub Text1_GotFocus()
LastLine = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0, 0&)
End Sub7 按F5， 开始运行。 在 TextBox 中多打入几行， 可以发现TextBox 的高度会自动修改， 甚至对剪贴操作也一样有效。 而在 TextBox 到了Form 的最大边缘后， 就停止了扩张高度。