frmmain.frm

疯狂五笔打字

               Index           =   0
               Left            =   30
               TabIndex        =   23
               Top             =   60
               Width           =   120
            End
         End
         Begin VB.Label LblT 
            Caption         =   "  Ctrl+.中英文标点之间的切换Shift+Space全角与半角之间的切换"
            Height          =   375
            Left            =   3480
            TabIndex        =   35
            Top             =   6000
            Visible         =   0   'False
            Width           =   3015
            WordWrap        =   -1  'True
         End
      End
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public SqlS As String
Dim I As Integer
Private Time_A, Time_B, Time_C As Integer
Private Time_X, Time_Y, Time_Z As String
Dim ER(6) As Integer
Dim RG(6) As Integer
Dim R As Integer
Dim J As Integer
Dim TimeCon As Integer

Private Sub CmdS_Click()
    ReDim TwoCode(0)
    LenStr = Rnd * 200 + 1
    CountE = 0
    CountR = 0
    ReadText = ""
    CEL = 0
    ' 初始化记时变量
    TmrTime.Interval = 0
    Time_X = "00"
    Time_Y = "00"
    Time_Z = "00"
    Time_A = 0
    Time_B = 0
    Time_C = 0
    If Letter = 5 Then
    FrmS.Show (vbModal)
    End If
    LblS.Caption = "用时: [00:00:00]"
    ' 隐藏输入控件
    Frainput.Visible = False
    FraTool.Visible = False
    TlbCh.Enabled = True
    LblErrar = "错误:0"
    LblRight = "正确:0"
    LblWord = "每分:0"
    ' 调用清空函数
    CEY
    ' 卸载lbl
    Unloadlbl
    ' 关闭文件
    Close #1
    ' 关闭SQL文件
    LblSplit.Caption = " 五笔拆分:"
    If (Letter = 3 And Choice = 2) Or (Letter = 3 And Choice = 3) Or (Letter = 3 And Choice = 4) Then
        StrSql = "delete from code"
        dbCon.Execute (StrSql)
        dbCon.Close
    End If
    CmdS.Visible = True
    LblT.Visible = False
End Sub

Private Sub Form_Load()
    App.HelpFile = App.Path & "\help.chm"
    Dim FrmWidth, FrmHeight As Integer
    LblSYSTime.Caption = Time()
    TimeCon = 0
    ScrM = 0
    Test = 5
    Time_X = "00"
    Time_Y = "00"
    Time_Z = "00"
    Letter = 0
    Choice = 0
    LenStr = 1
    FrmWidth = Screen.TwipsPerPixelX '控制窗口大小
    FrmHeight = Screen.TwipsPerPixelY
    FormWidth = FrmWidth * 800
    FormHeight = FrmHeight * 600
    FrmMain.Width = FormWidth
    FrmMain.Height = FormHeight
End Sub


Private Sub Form_Resize()
    If FrmMain.Height <= 465 And FrmMain.Width <= 2400 Then '使用户无法改变窗口大小
    Else
        FrmMain.Height = FormHeight
        FrmMain.Width = FormWidth
    End If
End Sub

Private Sub TlbCh_ButtonClick(ByVal Button As MSComctlLib.Button)
    If Button.Index = 1 Then
        Letter = 1
        LblName.Caption = Button.Caption
        FrmInputC.Show (vbModal)
    End If
    If Button.Index = 3 Then
        FrmTree.Show (vbModal)
        Letter = 2
        Choice = 0
    End If
    If Button.Index = 5 Then
        LblName.Caption = Button.Caption
        Letter = 3
        CountC
        FrmCC.Show (vbModal)
    End If
    If Button.Index = 7 Then
        LblName.Caption = Button.Caption
        Letter = 4
        openFile
        RndABC
        CountC
        Frainput.Visible = True
        FraTool.Visible = True
        TlbCh.Enabled = False
        TmrTime.Interval = 1000
    End If
    If Button.Index = 9 Then
        FrmClew.Show (vbModal)
        If Msg = 0 Then
            Msg = 1
            LblName.Caption = Button.Caption
            CmdS.Visible = False
            LblT.Visible = True
            Letter = 5
            openFile '打开文件
            RndABC
            CountC
            Frainput.Visible = True
            FraTool.Visible = True
            TlbCh.Enabled = False
            TmrTime.Interval = 1000
            TmrTest.Interval = 60000
        End If
    End If
    If Button.Index = 11 Then
        TlbCh.HelpFile = App.Path & "/help.chm"
        TlbCh.HelpContextID = 1
    End If
    If Button.Index = 13 Then
        FrmI.Show (vbModal)
    End If
    If Button.Index = 15 Then
    On Error GoTo Err9
        FrmSteup.Show (vbModal)
        Exit Sub
Err9:
        MsgBox "没有'TABCL32.OCX'支持", , "警告"
        FrmSteup1.Show (vbModal)
    End If
    If Button.Index = 17 Then
        FrmRE.Show (vbModal)
    End If
End Sub
Sub Unloadlbl() '卸载文字信息
    Dim I As Integer
    For I = 1 To LblText1.Count - 1
        Unload LblText1(I)
    Next I
    For I = 1 To LblText2.Count - 1
        Unload LblText2(I)
    Next I
    For I = 1 To LblText3.Count - 1
        Unload LblText3(I)
    Next I
    For I = 1 To LblText4.Count - 1
        Unload LblText4(I)
    Next I
    For I = 1 To LblText5.Count - 1
        Unload LblText5(I)
    Next I
    For I = 1 To LblText6.Count - 1
        Unload LblText6(I)
    Next I
    For I = 1 To LblText7.Count - 1
        Unload LblText7(I)
    Next I
End Sub


Private Sub TmrBeign_Timer() '调用用户登录窗口
    FrmUse.Show (vbModal)
    TmrBeign.Interval = 0
End Sub

Private Sub TmrSet_Timer() '定位焦点到第一个输入文本框
    TxtInput(0).SetFocus
    TmrSet.Interval = 0
End Sub

Private Sub TmrSYSTime_Timer() '得到当前系统时间
    LblSYSTime.Caption = Time()
End Sub

Private Sub TmrTest_Timer() '控制测试时间
    TimeCon = TimeCon + 1
    If TimeCon = Test Then
        TmrTest.Interval = 0
        TimeCon = 0
        Call CmdS_Click
    End If
End Sub

Private Sub TmrTime_Timer() '记时器
    Time_A = Time_A + 1
    If Time_A <= 9 Then
        Time_X = "0" & Time_A
    End If
    If Time_A >= 10 And Time_A <= 60 Then
        Time_X = Time_A
    End If
    If Time_A >= 60 Then
        Time_B = Time_B + 1
        Time_A = 0
        If Time_B <= 9 Then
            Time_Y = "0" & Time_B
        End If
        If Time_B >= 10 And Time_B <= 60 Then
            Time_Y = Time_B
        End If
        If Time_B >= 60 Then
                Time_C = Time_C + 1
                Time_B = 0
            If Time_C <= 9 Then
                Time_Z = Time_C
            End If
            If Time_C >= 10 And Time_C <= 24 Then
                Time_Z = Time_C
            End If
            If Time_C > 24 Then
                Time_C = 0
            End If
        End If
    End If
    R = 0
    For J = 1 To Time_B
        R = R + 60
    Next J
    R = R + Time_A
    If R <> 0 Then
        LblWord.Caption = "每分:" & Round((WordR + WordE) / (R / 60), 2) & "个字"
    End If
    If WordR + WordE = 0 Then
        LblWord.Caption = "每分:0个字"
    End If
    LblS.Caption = "用时:[" & Time_Z & ":" & Time_Y & ":" & Time_X & "]"
End Sub

Private Sub TxtInput_Change(Index As Integer)
    Dim I As Integer
    Dim Str As String
    Dim Str1 As String
    Dim Str2 As String
    If Letter = 2 And Choice = 0 Then
    Else
        If Index = 0 Then
            '查找二'三'全码汉字的字根
            If (Letter = 3 And Choice = 2) Or (Letter = 3 And Choice = 3) Or (Letter = 3 And Choice = 4) Then
                    If Len(TxtInput(Index).Text) < LblText1.Count Then
                        StrSql = "select * from code where word='" & LblText1(0).Caption & "'"
                    End If
                    SQLChar
            End If
            '查找一级简码的字根
            If Letter = 3 And Choice = 1 Then
                If Len(TxtInput(Index).Text) < LblText1.Count Then
                    StrSql = LblText1(0).Caption
                End If
                OChar
            End If
            If (Len(TxtInput(Index).Text) > 0) Then
                Str = Mid(TxtInput(Index).Text, Len(TxtInput(Index).Text), 1)
                '查找二'三'全码汉字的字根
                If (Letter = 3 And Choice = 2) Or (Letter = 3 And Choice = 3) Or (Letter = 3 And Choice = 4) Then
                    If Len(TxtInput(Index).Text) < LblText1.Count Then
                        StrSql = "select * from code where word='" & LblText1(Len(TxtInput(Index).Text)).Caption & "'"
                    Else
                        StrSql = "select * from code  where word='" & LblText2(0).Caption & "'"
                    End If
                    SQLChar  ' 汉字五笔编码查询
                End If
                If Letter = 3 And Choice = 1 Then '查找一级简码的字根
                    If Len(TxtInput(Index).Text) < LblText1.Count Then
                        StrSql = LblText1(Len(TxtInput(Index).Text)).Caption
                    Else
                        StrSql = LblText2(0).Caption
                    End If
                    OChar
                End If
                If (Str = LblText1(Len(TxtInput(Index).Text) - 1).Caption) Then
                    LblText1(Len(TxtInput(Index).Text) - 1).BackColor = &HFF0000
                Else
                    LblText1(Len(TxtInput(Index).Text) - 1).BackColor = &HFF&
                End If
            End If
            For I = Len(TxtInput(Index).Text) To LblText1.Count - 1
                LblText1(I).BackColor = &H8000000F
            Next I
            WordER (Index) '判断字符是是否正确
            If Len(TxtInput(Index).Text) = LblText1.Count Then
                TxtInput(0).Enabled = False
                TxtInput(1).Enabled = True
                TxtInput(1).SetFocus
            End If
        End If
        If Index = 1 Then
            If (Len(TxtInput(Index).Text) > 0) Then
                Str = Mid(TxtInput(Index).Text, Len(TxtInput(Index).Text), 1)
                If (Letter = 3 And Choice = 2) Or (Letter = 3 And Choice = 3) Or (Letter = 3 And Choice = 4) Then
                    If Len(TxtInput(Index).Text) < LblText1.Count Then
                        StrSql = "select * from code where word='" & LblText2(Len(TxtInput(Index).Text)) & "'"
                    Else