关于richtextbox行数和高度的问题

Question

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  nums  
 
Private  Sub  Form_Load()  
       Set  Me.Font  =  rchText.Font  
       LineHeight  =  Me.TextHeight("样本")  
       rchText.Height  =  LineHeight  
End  Sub  
 
Private  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  If  
 
End  Sub  
 
Private  Sub  Text1_GotFocus(Index  As  Integer)  
       LastLine  =  SendMessage(rchText1.hWnd,  EM_GETLINECOUNT,  0,  0&)  
 
End  Sub  
 
 
代码功能是richtextbox  高度随行数增加而增加  
 
但是运行的时候  rchtext1的第一行总是滚到最上面，看不到。而最后多出来一空白行！！！！！！！！  请帮忙看看    分还好商量：）

Answer 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 + 120
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) + 120    '注释：修改高度               
       End If
       
       While SendMessage(RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0) > 0
            Debug.Print "ddd"
            SendMessage RichTextBox1.hWnd, EM_SCROLL, SB_LINEUP, 0
       WendEnd Sub

Answer 2

对于中文输入修改了一下：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

Answer 3

RichTextBox1.Height = LastLine * (LineHeight) + 300这句改为：
RichTextBox1.Height = (LastLine) * (LineHeight + 70)

Answer 4

关于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
......

Answer 5

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