module1.bas

疯狂五笔打字

'        If Letter = 2 And Choice = 0 Then
'            FrmMain.LblText5(XY).Caption = Mid(Head(Int(Rnd * 177)), 1, 1)
'        End If
        If Letter = 3 And (Choice = 2 Or Choice = 3 Or Choice = 4) Then
            FrmMain.LblText5(XY).Caption = TwoCode(Int(Rnd * Countred))
        End If
        If Letter = 1 And Choice = 1 Then
            FrmMain.LblText5(XY).Caption = EABC(Int(Rnd * 53))
        End If
        Xrnd = Xrnd + FrmMain.LblText5(XY).Width
        XY = XY + 1
    Wend
    FrmMain.TxtInput(I).MaxLength = XY
End Sub
Sub M6() '载入第6行文本
    If Letter = 3 And Choice = 1 Then
        FrmMain.LblText6(0).Caption = Mid(OneCode(Int(Rnd * 25)), 1, 1)
    End If
'    If Letter = 2 And Choice = 0 Then
'        FrmMain.LblText6(0).Caption = Mid(Head(Int(Rnd * 177)), 1, 1)
'    End If
    If Letter = 3 And (Choice = 2 Or Choice = 3 Or Choice = 4) Then
        FrmMain.LblText6(0).Caption = TwoCode(Int(Rnd * Countred))
    End If
    If (Letter = 1 And Choice = 2) Or Letter = 4 Or Letter = 5 Then
        FrmMain.LblText6(0).Caption = Mid(ReadText, LenStr, 1)
        LenStr = LenStr + 1
    End If
    If Letter = 1 And Choice = 1 Then
        FrmMain.LblText6(0).Caption = EABC(Int(Rnd * 53))
    End If
    XY = 1
    Xrnd = 30 + (FrmMain.LblText6(0).Width)
    While (Xrnd <= (FrmMain.PicDispaly(0).Width - 200))
        Load FrmMain.LblText6(XY)
        FrmMain.LblText6(XY).Visible = True
        FrmMain.LblText6(XY).Left = Xrnd
        If (Letter = 1 And Choice = 2) Or Letter = 4 Or Letter = 5 Then
            StrC = Mid(ReadText, LenStr, 1)
            FrmMain.LblText6(XY).Caption = StrC
            LenStr = LenStr + 1
        End If
        If Letter = 3 And Choice = 1 Then
            FrmMain.LblText6(XY).Caption = Mid(OneCode(Int(Rnd * 25)), 1, 1)
        End If
'        If Letter = 2 And Choice = 0 Then
'            FrmMain.LblText6(XY).Caption = Mid(Head(Int(Rnd * 177)), 1, 1)
'        End If
        If Letter = 3 And (Choice = 2 Or Choice = 3 Or Choice = 4) Then
            FrmMain.LblText6(XY).Caption = TwoCode(Int(Rnd * Countred))
        End If
        If Letter = 1 And Choice = 1 Then
            FrmMain.LblText6(XY).Caption = EABC(Int(Rnd * 53))
        End If
        Xrnd = Xrnd + FrmMain.LblText6(XY).Width
        XY = XY + 1
    Wend
    FrmMain.TxtInput(I).MaxLength = XY
End Sub
Sub M7() '载入第7行文本
    If Letter = 3 And Choice = 1 Then
        FrmMain.LblText7(0).Caption = Mid(OneCode(Int(Rnd * 25)), 1, 1)
    End If
'    If Letter = 2 And Choice = 0 Then
'        FrmMain.LblText7(0).Caption = Mid(Head(Int(Rnd * 177)), 1, 1)
'    End If
    If Letter = 3 And (Choice = 2 Or Choice = 3 Or Choice = 4) Then
        FrmMain.LblText7(0).Caption = TwoCode(Int(Rnd * Countred))
    End If
    If (Letter = 1 And Choice = 2) Or Letter = 4 Or Letter = 5 Then
        FrmMain.LblText7(0).Caption = Mid(ReadText, LenStr, 1)
        LenStr = LenStr + 1
    End If
    If Letter = 1 And Choice = 1 Then
        FrmMain.LblText7(0).Caption = EABC(Int(Rnd * 53))
    End If
    XY = 1
    Xrnd = 30 + (FrmMain.LblText7(0).Width)
    While (Xrnd <= (FrmMain.PicDispaly(0).Width - 200))
        Load FrmMain.LblText7(XY)
        FrmMain.LblText7(XY).Visible = True
        FrmMain.LblText7(XY).Left = Xrnd
        If (Letter = 1 And Choice = 2) Or Letter = 4 Or Letter = 5 Then
            StrC = Mid(ReadText, LenStr, 1)
            FrmMain.LblText7(XY).Caption = StrC
            LenStr = LenStr + 1
        End If
        If Letter = 3 And Choice = 1 Then
            FrmMain.LblText7(XY).Caption = Mid(OneCode(Int(Rnd * 25)), 1, 1)
        End If
'        If Letter = 2 And Choice = 0 Then
'            FrmMain.LblText7(XY).Caption = Mid(Head(Int(Rnd * 177)), 1, 1)
'        End If
        If Letter = 3 And (Choice = 2 Or Choice = 3 Or Choice = 4) Then
            FrmMain.LblText7(XY).Caption = TwoCode(Int(Rnd * Countred))
        End If
        If Letter = 1 And Choice = 1 Then
            FrmMain.LblText7(XY).Caption = EABC(Int(Rnd * 53))
        End If
        Xrnd = Xrnd + FrmMain.LblText7(XY).Width
        XY = XY + 1
    Wend
    FrmMain.TxtInput(I).MaxLength = XY
    FrmMain.TmrSet.Interval = 10
End Sub
Public Sub openFile() '打开文件
    On Error GoTo Err2
    If Letter = 4 Then
        Open App.Path & "\E" & Int(Rnd * 6 + 2) & ".txt" For Input As #1
    End If
    If Letter = 1 And Choice = 2 Then
        Open App.Path & "\E1.txt" For Input As #1
    End If
    If Letter = 5 Then
        Open App.Path & "\E" & Int(Rnd * 6 + 2) & ".txt" For Input As #1
    End If
    While Not EOF(1)
        Line Input #1, SRead
        ReadText = ReadText & SRead
    Wend
    Close #1
    Exit Sub
Err2:
    MsgBox "无法打开文件可能被破坏如果要恢复请联系开发者", , "提示"
    End
End Sub
Public Sub Code() '初使化一级简码
    OneCode(0) = "一G"
    OneCode(1) = "地F"
    OneCode(2) = "在D"
    OneCode(3) = "要S"
    OneCode(4) = "工A"
    OneCode(5) = "上H"
    OneCode(6) = "是J"
    OneCode(7) = "中K"
    OneCode(8) = "国L"
    OneCode(9) = "同M"
    OneCode(10) = "和T"
    OneCode(11) = "的R"
    OneCode(12) = "有E"
    OneCode(13) = "人W"
    OneCode(14) = "我Q"
    OneCode(15) = "主Y"
    OneCode(16) = "产U"
    OneCode(17) = "不I"
    OneCode(18) = "为O"
    OneCode(19) = "这P"
    OneCode(20) = "民N"
    OneCode(21) = "了B"
    OneCode(22) = "发V"
    OneCode(23) = "以C"
    OneCode(24) = "经X"
End Sub
Sub ConSQL() '连接数据库
    On Error GoTo Err3
    dbCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Dictionary.mdb;Persist Security Info=False"
    dbCon.Open
    Exit Sub
Err3:
    MsgBox "无法打开数据库可能被破坏如果要恢复请联系开发者", , "提示"
    End
End Sub
Sub CopyData() '从数据库中提出数据
    On Error GoTo Err4
    Dim Str1 As String
    Dim Str2 As String
    StrSql = "delete from code"
    dbCon.Execute (StrSql)
    If Choice = 2 Then
        StrSql = "select * from word where Simple='2'"
    End If
    If Choice = 3 Then
        StrSql = "select * from word where Simple='3'"
    End If
    If Choice = 4 Then
        StrSql = "select * from word where Simple='4'"
    End If
    Set dbRed = dbCon.Execute(StrSql)
    Dim ss As Integer

    While Not dbRed.EOF
        Str1 = dbRed.Fields(0).Value
        Str2 = dbRed.Fields(1).Value
        StrSql = "insert into code values('" & Str1 & "','" & Str2 & "')"
        dbCon.Execute (StrSql)
        dbRed.MoveNext
    Wend
    StrSql = "select * from code"
    Set dbRed = dbCon.Execute(StrSql)
    Countred = 0
    While Not dbRed.EOF
        Countred = Countred + 1
        dbRed.MoveNext
    Wend
    ReDim TwoCode(Countred)
    dbRed.MoveFirst
    Dim sountred As Integer
    sountred = 0
    While Not dbRed.EOF
        TwoCode(sountred) = dbRed.Fields(0).Value
        dbRed.MoveNext
        sountred = sountred + 1
    Wend
    Exit Sub
Err4:
    MsgBox "无法提出数据可能被破坏如果要恢复请联系开发者", , "提示"
    End
End Sub
Sub EM() '初使化字母
    EABC(0) = "a"
    EABC(1) = "b"
    EABC(2) = "c"
    EABC(3) = "d"
    EABC(4) = "e"
    EABC(5) = "f"
    EABC(6) = "g"
    EABC(7) = "h"
    EABC(8) = "i"
    EABC(9) = "j"
    EABC(10) = "k"
    EABC(11) = "l"
    EABC(12) = "m"
    EABC(13) = "n"
    EABC(14) = "o"
    EABC(15) = "p"
    EABC(16) = "q"
    EABC(17) = "r"
    EABC(18) = "s"
    EABC(19) = "t"
    EABC(20) = "u"
    EABC(21) = "v"
    EABC(22) = "w"
    EABC(23) = "x"
    EABC(24) = "y"
    EABC(25) = "z"
    EABC(26) = "A"
    EABC(27) = "B"
    EABC(28) = "C"
    EABC(29) = "D"
    EABC(30) = "E"
    EABC(31) = "F"
    EABC(32) = "G"
    EABC(33) = "H"
    EABC(34) = "I"
    EABC(35) = "J"
    EABC(36) = "K"
    EABC(37) = "L"
    EABC(38) = "M"
    EABC(39) = "N"
    EABC(40) = "O"
    EABC(41) = "P"
    EABC(42) = "Q"
    EABC(43) = "R"
    EABC(44) = "S"
    EABC(45) = "T"
    EABC(46) = "U"
    EABC(47) = "V"
    EABC(48) = "W"
    EABC(49) = "X"
    EABC(50) = "Y"
    EABC(51) = "Z"
End Sub