form1.frm

来自「variant code in this rar zipped package」· FRM 代码 · 共 146 行

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form1 
   Caption         =   "英文单词识别的实现"
   ClientHeight    =   2445
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3960
   LinkTopic       =   "Form1"
   ScaleHeight     =   2445
   ScaleWidth      =   3960
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "退 出"
      Height          =   375
      Left            =   2880
      TabIndex        =   2
      Top             =   2040
      Width           =   855
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   1215
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   3495
      _ExtentX        =   6165
      _ExtentY        =   2143
      _Version        =   393217
      TextRTF         =   $"Form1.frx":0000
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   1560
      Width           =   3375
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Function WordRecognise(rtb As RichTextBox, _
x As Single, y As Single) As String
    Dim pnt As POINTAPI
    Dim TextNum As Integer
    Dim StartPos As Integer
    Dim EndPos As Integer
    Dim Char As String
    Dim gettext As String
    Dim gettextlen As Integer

    '将当前位置转换为pixels计量单位
     pnt.x = x \ Screen.TwipsPerPixelX
     pnt.y = y \ Screen.TwipsPerPixelY

    ' 取得文字的字符数
    TextNum = SendMessage(rtb.hWnd, EM_CHARFROMPOS, 0&, pnt)
    
    If TextNum <= 0 Then
        Exit Function
    End If

    ' 提取单词第一个字符位置
    gettext = rtb.Text
    For StartPos = TextNum To 1 Step -1
        Char = Mid$(rtb.Text, StartPos, 1)
        '取到的字符只能是数字或字母以及连字符“-”
    If Not ((Char >= "0" And Char <= "9") Or (Char >= "a" _
    And Char <= "z") Or (Char >= "A" And Char <= "Z") Or Char = "_") Then
            Exit For
        End If
    Next StartPos
    StartPos = StartPos + 1

    '提取单词最后一个字符位置
    gettextlen = Len(gettext)
    For EndPos = TextNum To gettextlen
        Char = Mid$(gettext, EndPos, 1)
        '取到的字符只能是数字或字母以及连字符“-”
        If Not ((Char >= "0" And Char <= "9") Or (Char >= "a" And _
        Char <= "z") Or (Char >= "A" And Char <= "Z") Or Char = "_") Then
            Exit For
        End If
    Next EndPos
    EndPos = EndPos - 1

    If StartPos <= EndPos Then
        '返回取得单词
        WordRecognise = Mid$(gettext, StartPos, EndPos - StartPos + 1)
    End If
End Function

Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
RichTextBox1.Text = "Good Good study" & Chr$(13) & Chr$(10) & "Day Day on" _
                     & Chr$(13) & Chr$(10) & "This is shenme ?"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label1.Caption = ""
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 Label1.Caption = ""
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim getword As String

    getword = WordRecognise(RichTextBox1, x, y)
    Select Case getword
    Case "Good"
        getword = "好"
    Case "study"
        getword = "学习"
    Case "Day"
        getword = "天"
    Case "on"
        getword = "向上"
    Case "This"
        getword = "这"
    Case "is"
        getword = "是"
    Case "shenme"
        getword = "不能识别的字符串"
    End Select
    If Label1.Caption <> getword Then
        Label1.Caption = getword
    End If
End Sub