怎么样定位Richtextbox里面鼠标点击的位置?由于文件里面含有中应为、空格还有公式等,所以我写的定位函数总是不行,函数本意是点击Richtextbox以后,如果鼠标位置有下划线的文字(关键字),那么得到下划线内容。请大侠执教。Public Const EM_CHARFROMPOS = &HD7
Public Type POINTAPI
    x As Long  'Long
    y As Long ' Long
End Type
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Function RichWordOver(rch 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
      
        RichWordOver = ""
    ' Convert the position to pixels.
       pt.x = x \ Screen.TwipsPerPixelX
       pt.y = y \ Screen.TwipsPerPixelY'------- Get the character number ------
    pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
  
    If pos <= 0 Then Exit Function
    
'------------ Find the start of the word.---------------------
    txt = rch.Text
    For start_pos = pos To 1 Step -1
        ch = Mid$(rch.Text, start_pos, 1)
        rch.SelStart = start_pos
        rch.Span ch
        If Not rch.SelUnderline Then Exit For
    Next start_pos
    
    start_pos = start_pos + 1
    
'----------- Find the end of the word.-------------------------
    txtlen = Len(txt)
    For end_pos = pos To txtlen Step 1
        ch = Mid$(txt, end_pos, 1)
        rch.SelStart = end_pos
        rch.Span ch
        If Not rch.SelUnderline 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 If   
        
End Function

解决方案 »

  1.   

    怎么样定位Richtextbox里面鼠标点击的位置?由于文件里面含有中英文、空格还有公式等,所以我写的定位函数总是不行,函数本意是点击Richtextbox以后,如果鼠标位置有下划线的文字(关键字),那么得到下划线内容。请大侠执教。Public Const EM_CHARFROMPOS = &HD7
    Public Type POINTAPI
        x As Long  'Long
        y As Long ' Long
    End Type
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Function RichWordOver(rch 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
          
            RichWordOver = ""
        ' Convert the position to pixels.
           pt.x = x \ Screen.TwipsPerPixelX
           pt.y = y \ Screen.TwipsPerPixelY'------- Get the character number ------
        pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
      
        If pos <= 0 Then Exit Function
        
    '------------ Find the start of the word.---------------------
        txt = rch.Text
        For start_pos = pos To 1 Step -1
            ch = Mid$(rch.Text, start_pos, 1)
            rch.SelStart = start_pos
            rch.Span ch
            If Not rch.SelUnderline Then Exit For
        Next start_pos
        
        start_pos = start_pos + 1
        
    '----------- Find the end of the word.-------------------------
        txtlen = Len(txt)
        For end_pos = pos To txtlen Step 1
            ch = Mid$(txt, end_pos, 1)
            rch.SelStart = end_pos
            rch.Span ch
            If Not rch.SelUnderline 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 If   
            
    End Function
      

  2.   

    问题解决。哈哈,简单之极啊,pos=rch.selstart  OK