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       '注释:每行的高度
Dim numsPrivate Sub Form_Load()
    Set Me.Font = rchText.Font
    LineHeight = Me.TextHeight("样本")
    rchText.Height = LineHeight
End SubPrivate Sub rchText1_Change()
    Dim Ret As Long
    Ret = SendMessage(rchText1.hWnd, EM_GETLINECOUNT, 0, 0&) '注释:取行数
   
    If Ret <> LastLine Then
        If rchText1.Height + rchText1.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
        rchText1.Height = LastLine * LineHeight '注释:修改高度
       
    End IfEnd SubPrivate Sub Text1_GotFocus(Index As Integer)
    LastLine = SendMessage(rchText1.hWnd, EM_GETLINECOUNT, 0, 0&)End Sub
代码功能是richtextbox 高度随行数增加而增加dan但是运行的时候 rchtext1的第一行总是滚到最上面,看不到。而最好多出来一空白行!!!!!!!! 请帮忙看看  分还好商量:)

解决方案 »

  1.   

    Const EM_GETLINECOUNT = &HBA
    Const EM_SCROLL = &HB5
    Const SB_LINEUP = 0
    Const EM_GETFIRSTVISIBLELINE = &HCE
    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               '注释:每行的高度
    Dim nums
     
    Private Sub Form_Load()
           Set Me.Font = RichTextBox1.Font
           LineHeight = Me.TextHeight("样本")
           RichTextBox1.Height = LineHeight + 150
    End Sub
     
    Private Sub Text1_GotFocus(Index As Integer)
           LastLine = SendMessage(RichTextBox1.hWnd, EM_GETLINECOUNT, 0, 0&)
    End SubPrivate Sub RichTextBox1_Change()
           Dim Ret   As Long
           
           Ret = SendMessage(RichTextBox1.hWnd, EM_GETLINECOUNT, 0, 0&)       '注释:取行数
           
           If Ret <> LastLine Then
                   If RichTextBox1.Height + RichTextBox1.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
                   RichTextBox1.Height = LastLine * (LineHeight) + 300    '注释:修改高度               
           End If
           
           While SendMessage(RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0) > 0
                Debug.Print "ddd"
                SendMessage RichTextBox1.hWnd, EM_SCROLL, SB_LINEUP, 0
           WendEnd Sub加了一个判断第一个可见行是不是第一行。另外你需要把高度设置高一点,这样可以在输入的时候保持输入行和第一行都是完全可见的。
      

  2.   

    关于RichText控件的自动行高问题,你查查EN_REQUESTRESIZE消息吧!~这才是解决该问题的终极方法!~
    需要用到SubClas技术。部分代码如下:
    '先绑定消息:
        '自动适应尺寸   
        SendMessageLong m_hWnd, EM_SETEVENTMASK, 0, ENM_REQUESTRESIZE      '设置事件掩码'再在SubClass消息处理中加入:    Case WM_NOTIFY  '系统通知
            CopyMemory tNMH, ByVal lParam, Len(tNMH)
            If (tNMH.hwndFrom = m_hWnd) Then
                Select Case tNMH.code
                Case EN_REQUESTRESIZE
                    Dim lngH As Long
                    Call CopyMemory(rResize, ByVal lParam, Len(rResize))
                    lngH = (rResize.rc.Bottom - rResize.rc.Top) * Screen.TwipsPerPixelY
                    rtbThis.Height = lngH
    ......
      

  3.   

    你前面的方法有问题,为什么呢?因为需要考虑行间距、段间距,另外还需要考虑插入的图片等OLE对象的高度,所以用我提供的方法可以完全解决这些问题。
    不过有唯一一个问题:控件高度有限制的!~
      

  4.   

    http://www.cnpopsoft.com/blog/article.asp?id=3
    看看里面关于“Bottomless”的描述就知道了!~