急~~~~~RichTextBox中如何得到鼠标下的字符串？新手，请大家帮帮忙~~

Question

从库中读取RTF的字符编码在RichTextBox中显示，想问一下能不能得到鼠标点击处的字符串或？

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 Long
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEFROMCHAR = &HC9private sub Command1_Click()
  dim Lops as long,Cops as Long,LineLength as Long  Lops = SendMessage(RichText1.Hwnd, Em_LineFromChar,RichText1.SelStart,0)  '行數
  Cops = SendMessage(RichText1.Hwnd, Em_LineIndex,Lops,0)            '當前字符位置
  LineLength = SendMessage(RichText1.Hwnd, Em_LineLength,Cops,0)     '字數
end sub

Answer 2

Option ExplicitPrivate Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
    X As Long
    Y As Long
End TypePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long' Return the word the mouse is over.
Public Function RichWordOver(rtf As RichTextBox, X As Single, Y As Single) As String
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer    ' 把位置坐标转换为像素.
    pt.X = X \ Screen.TwipsPerPixelX
    pt.Y = Y \ Screen.TwipsPerPixelY    ' Get the character number
    pos = SendMessage(rtf.hWnd, EM_CHARFROMPOS, 0&, pt)
    If pos <= 0 Then Exit Function    '查找单词的开始位置.
    txt = rtf.Text
    For start_pos = pos To 1 Step -1
        ch = Mid$(rtf.Text, start_pos, 1)
        ' 允许数字,字母,下划线
        If Not ( _
            (ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or _
            ch = "_" _
        ) Then Exit For
    Next start_pos
    start_pos = start_pos + 1    '查找单词的结尾
    txtlen = Len(txt)
    For end_pos = pos To txtlen
        ch = Mid$(txt, end_pos, 1)
        ' 允许数字,字母,下划线
        If Not ( _
            (ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or _
            ch = "_" _
        ) Then Exit For
    Next end_pos
    end_pos = end_pos - 1    If start_pos <= end_pos Then _
        RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End FunctionPrivate Sub Form_Load()
    rtfTest.Text = "Welcome to use source code provided by Alp Studio" & _
        vbCrLf & vbCrLf & "This example program is provided as is with no warranty of any kind" & _
        vbCrLf & vbCrLf & "Send the control the EM_CHARFROMPOS message to make it return the character closest to the mouse position." & _
        vbCrLf & vbCrLf & "http://dropwater.163.net"
End SubPrivate Sub rtftest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim txt As String    txt = RichWordOver(rtfTest, X, Y)
    If lblCurrentWord.Caption <> txt Then _
        lblCurrentWord.Caption = txt
End Sub

Answer 3

Option ExplicitPrivate Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
    X As Long
    Y As Long
End TypePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long' Return the word the mouse is over.
Public Function RichWordOver(rtf As RichTextBox, X As Single, Y As Single) As String
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer    ' 把位置坐标转换为像素.
    pt.X = X \ Screen.TwipsPerPixelX
    pt.Y = Y \ Screen.TwipsPerPixelY    ' Get the character number
    pos = SendMessage(rtf.hWnd, EM_CHARFROMPOS, 0&, pt)
    If pos <= 0 Then Exit Function    '查找单词的开始位置.
    txt = rtf.Text
    For start_pos = pos To 1 Step -1
        ch = Mid$(rtf.Text, start_pos, 1)
        ' 允许数字,字母,下划线
        If Not ( _
            (ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or _
            ch = "_" _
        ) Then Exit For
    Next start_pos
    start_pos = start_pos + 1    '查找单词的结尾
    txtlen = Len(txt)
    For end_pos = pos To txtlen
        ch = Mid$(txt, end_pos, 1)
        ' 允许数字,字母,下划线
        If Not ( _
            (ch >= "0" And ch <= "9") Or _
            (ch >= "a" And ch <= "z") Or _
            (ch >= "A" And ch <= "Z") Or _
            ch = "_" _
        ) Then Exit For
    Next end_pos
    end_pos = end_pos - 1    If start_pos <= end_pos Then _
        RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End FunctionPrivate Sub Form_Load()
    rtfTest.Text = "Welcome to use source code provided by Alp Studio" & _
        vbCrLf & vbCrLf & "This example program is provided as is with no warranty of any kind" & _
        vbCrLf & vbCrLf & "Send the control the EM_CHARFROMPOS message to make it return the character closest to the mouse position." & _
        vbCrLf & vbCrLf & "http://dropwater.163.net"
End SubPrivate Sub rtftest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim txt As String    txt = RichWordOver(rtfTest, X, Y)
    If lblCurrentWord.Caption <> txt Then _
        lblCurrentWord.Caption = txt
End Sub

Answer 4

我再顶~~
问题是这样的：
richtextbox中的内容很多，
我点击左边的标号，richtextbox中的相应的内容会跳出来，并且在richtextbox中的最顶端，和网页中的锚标记一样，怎么实现？这个问题搞死我了，刚学VB，请高手帮忙，解决了再送100分~!~~~帮我UP也有分~~

Answer 5

>题是这样的：
>richtextbox中的内容很多，
>我点击左边的标号，richtextbox中的相应的内容会跳出来，并且在richtextbox中的最顶端，和网页中的锚标记一样，怎么实现？这个问题搞死我了，刚学VB，请高手帮忙，解决了再送100分~!~~~>帮我UP也有分~~先要清楚的说明你要什么？（看看《软件需求》第9章吧，可能对你有所启发）
“我点击左边的标号” ----RichTextBox左边怎么会有标号
“richtextbox中的相应的内容会跳出来” ------？？？？？？？？？
我帮不了你！