郁闷~~在VB版里发了几个帖子问题都没有解决，再发一帖~~~第一次到这面很受打击~~~~

Question

再问一个问题：richtextbox的文本很长，用户可以通过scrollbar来上下滚动文本，请问用什么方法可以获得文本的当前行数，滚动有没有什么事件？可以通过鼠标滚轴或点scroolbar来查看，怎么取得这个事件？不知我描述得还清楚，请大家帮帮忙~~~

Answer 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 LongConst EM_GETFIRSTVISIBLELINE = &HCE
Const EM_LINEFROMCHAR = &HC9
Const EM_GETLINECOUNT = &HBAPublic Function TopLineIndex(txtBox As RichTextBox) As Long
    TopLineIndex = SendMessage(txtBox.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End FunctionPublic Function GetLineFromChar(txtBox As RichTextBox, CharPos As Long) As Long
    GetLineFromChar = SendMessage(txtBox.hwnd, EM_LINEFROMCHAR, CharPos, 0&)
End Function
 
Public Function LineCount(txtBox As RichTextBox) As Long
     LineCount = SendMessage(txtBox.hwnd, EM_GETLINECOUNT, 0&, 0&)
End Function
Private Sub Command1_Click()
    Dim lngLineIndex As Long
    Dim lngLineCount As Long
     lngLineIndex = GetLineFromChar(RichTextBox1, RichTextBox1.SelStart)
     lngLineCount = LineCount(RichTextBox1)
     MsgBox "当前行号: " & lngLineIndex + 1
     MsgBox "总行数: " & lngLineCount
End Sub

Answer 2

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     lParam As Any) As LongConst EM_GETFIRSTVISIBLELINE = &HCE
Const EM_LINEFROMCHAR = &HC9
Const EM_GETLINECOUNT = &HBA
Const EM_LINEINDEX = &HBBPublic Function TopLineIndex(txtBox As RichTextBox) As Long
    TopLineIndex = SendMessage(txtBox.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End FunctionPublic Function GetLineFromChar(txtBox As RichTextBox, CharPos As Long) As Long
    GetLineFromChar = SendMessage(txtBox.hwnd, EM_LINEFROMCHAR, CharPos, 0&)
End Function
 
Public Function LineCount(txtBox As RichTextBox) As Long
     LineCount = SendMessage(txtBox.hwnd, EM_GETLINECOUNT, 0&, 0&)
End FunctionPublic Function ColIndex(txtBox As RichTextBox, Lops As Long) As Long
     ColIndex = SendMessage(txtBox.hwnd, EM_LINEINDEX, Lops, 0)
End FunctionPrivate Sub RichTextBox1_SelChange()
    Dim lngLineIndex As Long
    Dim lngLineCount As Long
    Dim lngColIndex As Long
     lngLineIndex = GetLineFromChar(RichTextBox1, RichTextBox1.SelStart)
     lngLineCount = LineCount(RichTextBox1)
     lngColIndex = SendMessage(RichTextBox1.hwnd, EM_LINEINDEX, lngLineIndex, 0)
     Label1.Caption = "当前行号: " & lngLineIndex + 1
     Label2.Caption = "当前位置: " & lngColIndex
     Label3.Caption = "总行数: " & lngLineCount
End Sub

Answer 3

’form1
Option Explicit
'获得第一个可视行号
Private Sub Command1_Click()
  Text1.Text = SendMessage(RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
End SubPrivate Sub Form_Load()
   'RichTextBox1.ScrollBars = rtfBoth  要设定
   '要先输入一些内容
  SubClass RichTextBox1.hWnd
  
End SubPrivate Sub Form_Unload(Cancel As Integer)
  UnSubClass RichTextBox1.hWnd
End Sub
‘模块
'消息响应机制
Public Const SM_CXHSCROLL = 21
Public Const GWL_STYLE = (-16)
Public Const WS_HSCROLL = &H100000
Public Const WS_VSCROLL = &H200000
Public Const SB_BOTH = 3
Public Const SB_HORZ = 0
Public Const SB_VERT = 1Public Const SM_CXVSCROLL = 2
Public Const SM_CYVSCROLL = 20'以下以SB_开头的是用户的滚动请求
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_LINERIGHT = 1
Public Const SB_LINEUP = 0
Public Const SB_PAGERIGHT = 3
Public Const SB_PAGELEFT = 2
Public Const SB_PAGEDOWN = 3
Public Const SB_PAGEUP = 2
Public Const SB_ENDSCROLL = 8
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5Public Const GWL_WNDPROC = (-4)
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public 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
Public Const EM_GETFIRSTVISIBLELINE = &HCEPublic preWndProc As LongPublic Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
        Case WM_VSCROLL '垂直滚动条消息
              Form1.Text1.Text = SendMessage(Form1.RichTextBox1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
        Case WM_HSCROLL '水平条消息
           
        End SelectWindowProc = CallWindowProc(preWndProc, hWnd, uMsg, wParam, lParam)End FunctionPublic Sub SubClass(mhwnd As Long)
   preWndProc = SetWindowLong(mhwnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPublic Sub UnSubClass(mhwnd As Long)
   Call SetWindowLong(mhwnd, GWL_WNDPROC, preWndProc)
End Sub

Answer 4

去查查API函数，那里有一些关于当前进程的调用函数，特别是处理消息的API！

Answer 5

我记得又一个控件叫ComeRichT。大约可以满足你的要求。好像还挺强大的。你搜索一下看看呢。

Answer 6

Const EM_LINESCROLL = &HB6
Const EM_LINEINDEX = &HBB
Const EM_LINEFROMCHAR = &HC9Private Declare Function SendMessage Lib "user32" Alias _
     "SendMessageA" _
     (ByVal hwnd As Long, _
     ByVal wMsg As Integer, _
     ByVal wParam As Integer, _
     ByVal lParam As Long) As LongDim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim con2 As New ADODB.Connection
Dim rs2 As New ADODB.Recordset
Dim profile
Dim p_Profile
Dim apro As String
Dim i As Integer
Dim num As Integer
Dim answ(100) As String
Dim n As IntegerPublic Sub show()'数据库连接'创建题目列表树
Dim pNode
  Set pNode = prolist.Nodes.Add(, , "Root", "题目列表")    For i = 0 To UBound(p_Profile)
    
        '取得题目     
        
      '取得题目类型        
         
      ' 取得答案

 
     '添加题目列表的子节点
        
     On Error Resume Next
     
     test = prolist.Nodes.Item(p_type).Text
     
     If Err = 35601 Then
        Set pNode = prolist.Nodes.Add("Root", tvwChild, p_type, p_type2)
     End If
     
     Set pNode = prolist.Nodes.Add(p_type, tvwChild, , i + 1)
        pNode.EnsureVisible
        
    Next
    
       rtf_pro.TextRTF = "{\rtf1\ansi \deff0\deflang1033" & apro & "}"
End Sub'判断题目类型
Public Function gettype(t_id)
Dim t
    Select Case t_id
            Case 0
             t = "pd" '判断题
            Case 1
             t = "xz" '选择题
            Case 2
             t = "tk"
            Case 4
             t = "jd"
    End Select
    gettype = t
End FunctionPublic Function gettype2(t_id)
Dim t
    Select Case t_id
            Case 0
             t = "判断题"
            Case 1
             t = "选择题"
            Case 2
             t = "填空题"
            Case 4
             t = "问答题"
    End Select
    gettype2 = t
End Function'转换试题内容Public Function cto(str As String, i)
    num = i + 1
    str = Replace(str, "{\rtf1\ansi \deff0\deflang1033", " ")
    str = Replace(str, "\par }}", "\par }")
    str = "{" & num & ".}  " & str
    cto = strEnd Function
Private Sub prolist_Click()     pid = prolist.SelectedItem
     
 If IsNumeric(pid) Then
    p = pid - 1
    rtf_anw.TextRTF = "第 " & pid & " 题答案是： " & answ(p)       ps = rtf_pro.Find(pid & ".")       Lin = rtf_pro.GetLineFromChar(ps)
        
        If ps >= 0 Then
        
         Dim lngRet As Long
         lngRet = SendMessage(rtf_pro.hwnd, EM_LINESCROLL, 0, 14&)         rtf_pro.SelStart = ps
         rtf_pro.SetFocus
              
        End If
  Else
 rtf_anw.Text = "请点左边的题号查看相应的答案!"
 End If
 
End SubPrivate Sub UserControl_Initialize()
        Call show
       
End Sub这是我这个控件的主要源码，主要用了一个treeview，两个richtextbox：rtf_pro,rtf_anw
rtf_pro是用来显示试题的，由一张试卷较大，所以会出现滚动条，现在要解决的问题是，我拖动滚动条，最上面是第几题 ，在下面显示答案的rtf_anw就显示相题的答案。
本人以前没用过VB，还请大家多多帮忙，这个问题搞死我了~~~：(