精华区文章阅读

发信人: bloom (├┝┞┟┠┡┢┣), 信区: VB
标  题: 像金山词霸那样取词(转载)
发信站: 哈工大紫丁香 (2000年07月28日17:50:25 星期五), 转信

发信站: BBS 水木清华站 (Fri Jul 28 00:02:38 2000)

一个取词的例子
一个richtextbox，两个label
代码如下：

Option Explicit
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVa
l hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long
Long
' Return the word the mouse is over.
Public Function RichWordOver(rtf As RichTextBox, X As Single, Y As Single) A
s 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 ( _
        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 Function
Private 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 wa
rranty of any kind" & _
        vbCrLf & vbCrLf & "Send the control the EM_CHARFROMPOS message to ma
ke it return the character closest to the mouse position." & _
        vbCrLf & vbCrLf & "http://dropwater.163.net"
End Sub
Private Sub rtftest_MouseMove(Button As Integer, Shift As Integer, X As Sing
le, Y As Single)
Dim txt As String
    txt = RichWordOver(rtfTest, X, Y)
    If lblCurrentWord.Caption <> txt Then _
        lblCurrentWord.Caption = txt
End Sub

【在 inwind (针★我是一根风中针) 的大作中提到: 】
: 想做这么一个软件，就是平时看英文文献，想把那些有用的词汇
: 或者生疏的词汇，从屏幕上去下来，（类似金山词霸），然后
: 对于每个取下来的词汇，加以注释、发音、以及屏幕上采集下来
: 的例句。经过这样编辑后，以后就来复习用。
⒁簟⒁约捌聊簧喜杉吕?
: 的例句。经过这样编辑后，以后就来复习用。
: 据说金山词霸使用VC变动，现在我刚学习用VB，
: 能用VB编吗？主要是取词，取例句，然后加以注释、发音等。

--

        我是一只小小鸟，但总想飞的更高些
?
欢迎访问我的ftp ftp：//202.112.139.6

※ 来源:·BBS 水木清华站 smth.org·[FROM: 202.112.137.7]

--
├┝┞┟┠┡┢┣ ※↑

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.226.225]

VB 版 (精华区)