frmtesten.frm

加减乘除练习用的程序

VERSION 4.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1020
   ClientLeft      =   1785
   ClientTop       =   1455
   ClientWidth     =   8415
   Height          =   1425
   Left            =   1725
   LinkTopic       =   "Form1"
   ScaleHeight     =   1020
   ScaleWidth      =   8415
   Top             =   1110
   Width           =   8535
   Begin VB.CommandButton Command2 
      Caption         =   "&English"
      Height          =   375
      Left            =   2640
      TabIndex        =   3
      Top             =   240
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "&Dutch"
      Height          =   375
      Left            =   960
      TabIndex        =   2
      Top             =   240
      Width           =   1575
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   120
      MaxLength       =   7
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   240
      Width           =   735
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   195
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   7095
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False

Option Explicit


Private Function Convert5(bron$) As String
    Dim vH$, vT$
    
    vH$ = Convert2(Left$(bron$, 2))
    vH$ = vH$ & "duizend"
    vT$ = Convert3(Right$(bron$, 3))
    Convert5 = vH$ & vT$

End Function


Private Function Convert1(bron$) As String
    Select Case Val(bron$)
    Case 0
        Convert1 = "nul"
    Case 1
        Convert1 = "een"
    Case 2
        Convert1 = "twee"
    Case 3
        Convert1 = "drie"
    Case 4
        Convert1 = "vier"
    Case 5
        Convert1 = "vijf"
    Case 6
        Convert1 = "zes"
    Case 7
        Convert1 = "zeven"
    Case 8
        Convert1 = "acht"
    Case 9
        Convert1 = "negen"
    End Select
    
End Function

Private Function Convert2(bron$) As String
    Dim vdummy$
    
    Select Case Val(Left$(bron$, 1))
    Case 1
        vdummy$ = "tien"
    Case 2
        vdummy$ = "entwintig"
    Case 3
        vdummy$ = "endertig"
    Case 4
        vdummy$ = "enveertig"
    Case 5
        vdummy$ = "envijftig"
    Case 6
        vdummy$ = "enzestig"
    Case 7
        vdummy$ = "enzeventig"
    Case 8
        vdummy$ = "entachtig"
    Case 9
        vdummy$ = "ennegentig"
    End Select
    
    Select Case Val(Right$(bron$, 1))
    Case 1
        If Val(Left$(bron$, 1)) = 1 Then
            vdummy$ = "elf"
        Else
            vdummy$ = "een"
        End If
    Case 2
        If Val(Left$(bron$, 1)) = 1 Then
            vdummy$ = "twaalf"
        Else
            vdummy$ = "twee"
        End If
    Case 3
        If Val(Left$(bron$, 1)) = 1 Then
            vdummy$ = "der" & vdummy$
        Else
            vdummy$ = "drie" & vdummy$
        End If
    Case 4
        vdummy$ = "veer" & vdummy$
    Case 5
        vdummy$ = "vijf" & vdummy$
    Case 6
        vdummy$ = "zest" & vdummy$
    Case 7
        vdummy$ = "zeven" & vdummy$
    Case 8
        vdummy$ = "acht" & vdummy$
    Case 9
        vdummy$ = "negen" & vdummy$
    End Select
    
    Convert2 = vdummy$
    
End Function

Private Function Convert4(bron$) As String
    Dim vH$, vT$
    
    vH$ = Convert1(Left$(bron$, 1))
    'we say thousand and not one thousand; that's the next line
    If vH$ <> "een" Then vH$ = vH$ & "duizend" Else vH$ = "duizend"
    vT$ = Convert3(Right$(bron$, 3))
    Convert4 = vH$ & vT$

End Function
Private Function Convert6(bron$) As String
    Dim vH$, vT$
    
    vH$ = Convert3(Left$(bron$, 3))
    vH$ = vH$ & "duizend"
    vT$ = Convert3(Right$(bron$, 3))
    Convert6 = vH$ & vT$

End Function
Private Function Convert7(bron$) As String
    Dim vH$, vT$
    
    vH$ = Convert1(Left(bron$, 1))
    vH$ = vH$ & "miljoen"
    vT$ = Convert6(Right$(bron$, 6))
    Convert7 = vH$ & vT$

End Function
Private Sub Command1_Click()
    If text1.Text = "" Then Exit Sub
    
    Select Case Len(text1.Text)
    Case 1
        Label1.Caption = Convert1(text1.Text)
    Case 2
        Label1.Caption = Convert2(text1.Text)
    Case 3
        Label1.Caption = Convert3(text1.Text)
    Case 4
        Label1.Caption = Convert4(text1.Text)
    Case 5
        Label1.Caption = Convert5(text1.Text)
    Case 6
        Label1.Caption = Convert6(text1.Text)
    Case 7
        Label1.Caption = Convert7(text1.Text)
    Case Else
        Label1.Caption = "to big!!"
    End Select
    
    text1.SetFocus
    SendKeys "+{END}"
    
End Sub

Private Function Convert3(bron$) As String
    Dim vH$, vT$
    
    vH$ = Convert1(Left$(bron$, 1))
    If vH$ <> "een" Then vH$ = vH$ & "honderd" Else vH$ = "honderd"
    vT$ = Convert2(Right$(bron$, 2))
    Convert3 = vH$ & vT$
    
End Function

' Convert an integer into an English string
Function English(ByVal N As Long) As String
    Const Thousand = 1000&
    Const Million = Thousand * Thousand
    Const Billion = Thousand * Million
    'Const Trillion = Thousand * Billion

    Dim Buf As String: Buf = ""

    If (N = 0) Then English = "zero": Exit Function

    If (N < 0) Then Buf = "negative ": N = -N

    If (N >= Billion) Then
        Buf = Buf & EnglishDigitGroup(N \ Billion) & " billion"
        N = N Mod Billion
        If (N) Then Buf = Buf & " "
    End If

    If (N >= Million) Then
        Buf = Buf & EnglishDigitGroup(N \ Million) & " million"
        N = N Mod Million
        If (N) Then Buf = Buf & " "
    End If

    If (N >= Thousand) Then
        Buf = Buf & EnglishDigitGroup(N \ Thousand) & " thousand"
        N = N Mod Thousand
        If (N) Then Buf = Buf & " "
    End If

    If (N > 0) Then
        Buf = Buf & EnglishDigitGroup(N)
    End If

    English = Buf
End Function

' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal N As Integer) As String
    Const Hundred = " hundred"
    Const One = "one"
    Const Two = "two"
    Const Three = "three"
    Const Four = "four"
    Const Five = "five"
    Const Six = "six"
    Const Seven = "seven"
    Const Eight = "eight"
    Const Nine = "nine"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer: Flag = False

    'Do hundreds
    Select Case (N \ 100)
    Case 0: Buf = "":  Flag = False
    Case 1: Buf = One & Hundred: Flag = True
    Case 2: Buf = Two & Hundred: Flag = True
    Case 3: Buf = Three & Hundred: Flag = True
    Case 4: Buf = Four & Hundred: Flag = True
    Case 5: Buf = Five & Hundred: Flag = True
    Case 6: Buf = Six & Hundred: Flag = True
    Case 7: Buf = Seven & Hundred: Flag = True
    Case 8: Buf = Eight & Hundred: Flag = True
    Case 9: Buf = Nine & Hundred: Flag = True
    End Select

    If (Flag) Then N = N Mod 100
    If (N) Then
        If (Flag) Then Buf = Buf & " "
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If

    'Do tens (except teens)
    Select Case (N \ 10)
    Case 0, 1: Flag = False
    Case 2: Buf = Buf & "twenty": Flag = True
    Case 3: Buf = Buf & "thirty": Flag = True
    Case 4: Buf = Buf & "forty": Flag = True
    Case 5: Buf = Buf & "fifty": Flag = True
    Case 6: Buf = Buf & "sixty": Flag = True
    Case 7: Buf = Buf & "seventy": Flag = True
    Case 8: Buf = Buf & "eighty": Flag = True
    Case 9: Buf = Buf & "ninety": Flag = True
    End Select

    If (Flag) Then N = N Mod 10
    If (N) Then
        If (Flag) Then Buf = Buf & "-"
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If

    'Do ones and teens
    Select Case (N)
    Case 0: ' do nothing
    Case 1: Buf = Buf & One
    Case 2: Buf = Buf & Two
    Case 3: Buf = Buf & Three
    Case 4: Buf = Buf & Four
    Case 5: Buf = Buf & Five
    Case 6: Buf = Buf & Six
    Case 7: Buf = Buf & Seven
    Case 8: Buf = Buf & Eight
    Case 9: Buf = Buf & Nine
    Case 10: Buf = Buf & "ten"
    Case 11: Buf = Buf & "eleven"
    Case 12: Buf = Buf & "twelve"
    Case 13: Buf = Buf & "thirteen"
    Case 14: Buf = Buf & "fourteen"
    Case 15: Buf = Buf & "fifteen"
    Case 16: Buf = Buf & "sixteen"
    Case 17: Buf = Buf & "seventeen"
    Case 18: Buf = Buf & "eighteen"
    Case 19: Buf = Buf & "nineteen"
    End Select

    EnglishDigitGroup = Buf
End Function




Private Sub Command2_Click()
    Label1.Caption = EnglishDigitGroup(CInt(text1.Text))
    
End Sub

Private Sub Form_Load()
    Me.Caption = "Convert Integers to Text    "
    text1.Text = ""
    Label1.Caption = ""
    
End Sub