难啊！如何确定一定大小的字体在Richtext能显示多少行？

Question

Richtext的高度是固定的，那么字体的大小调整后能显示出来的行数就不同，请问高手们怎样计算这个行数呢？另外是否能考虑行间距？

Answer 1

判断：richtextbox的width是多少然后，由于字体是一定的（现在都是truetype字体）
通过计算richtextbox的width/字体width即可

Answer 2

用高度算更科学一些，下面的程序是计算字体高度的：
Option Explicit
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Sub Command1_Click()
    Dim mDC As Long
    Dim i As Long
    Dim TEXTSIZE As POINTAPI
    mDC = GetDC(RichTextBox1.hwnd)
    i = GetTextExtentPoint32(mDC, "啊", 2, TEXTSIZE)
    If i <> 0 Then
        MsgBox "字体高度：" + CStr(TEXTSIZE.Y) + "像素"
    End If
    ReleaseDC RichTextBox1.hwnd, mDC
End Sub

Answer 3

如果你的RICHTEXTBOX带滚动条,就好办了(有时会有1行的误差):Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As LongPrivate Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const SB_PAGEDOWN = 3
Private Const WM_VSCROLL = &H115
Dim fsize As Integer
Private Sub Command1_Click()
SETFONT
MsgBox "可容纳 " & getvisiblelines(RichTextBox1) & " 行", vbOKCancel, ""
End Sub
Private Sub Form_Load()
SETFONT
RichTextBox1.Text = Replace(String(1000, "x"), "x", "中国软件CSDN")
End Sub
Sub SETFONT()
Randomize
RichTextBox1.font.Name = Screen.Fonts(Int(Rnd * 20) + 1)
RichTextBox1.font.Size = 5 + Int(Rnd * 30)
Me.Caption = "字体：" & RichTextBox1.font.Name & "，字号：" & RichTextBox1.font.Size
End SubFunction getvisiblelines(ByVal txtbox As RichTextBox) As Integer
txtbox.SetFocus
txtbox.SelStart = 0
getvisiblelines = SendMessage(RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
SendMessage txtbox.hWnd, WM_VSCROLL, SB_PAGEDOWN, 1& '1 pagedown
getvisiblelines = SendMessage(RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0) + 1 - getvisiblelines
End Function

Answer 4

3楼的方法我试了一下，可是不管我怎么改变richtext中字体的大小，始终显示16像素高，不知道是怎么回事？

Answer 5

我测试了一下,确实发现了问题,你先这样算字体高度:
Private Sub Command1_Click()
    Dim oldfont As StdFont
    Set oldfont = Me.Font
    Set Me.Font = RichTextBox1.Font
    Dim i As Single
    i = Me.TextHeight("啊")
    Dim mheight As Single
    mheight = Me.ScaleY(i, Me.ScaleMode, vbPixels)
    Set Me.Font = oldfont
    Set oldfont = Nothing
    MsgBox mheight
End Sub