In dit relatief complex programma schrijven we getallen volledig uit in het Spaans.
Op een formulier plaatsen we knoppen waarmee de gebruiker / leerder kan kiezen welk soort activiteit hij wil uitvoeren (lezen of schrijven). We laten ook kiezen waar te starten, hoeveel oefeningen en welke intervalwaarde (5 geeft dan 10 - 15 - 20 enz). We maken een functie voor het uitschijven van getallen, waarbij het getal wordt opgedeeld in groepen van drie, die op huin beurt uitgeschreven worden.
De code van het formulier is:
Dim aantaloef As Integer
Dim aantalgemaakt As Integer
Dim aantalcorrect As Integer
Dim getal As Long
Dim min As Long
Dim max As Long
Dim interval As Integer
Dim modus As String
Dim gekozen(1000) As Integer
Function IsInteger(test As String) As Boolean
If Not IsNumeric(test) Then
IsInteger = False
Exit Function
Else
If Int(test) = test Then IsInteger = True
End If
End Function
Private Sub cmdEscribir_Click()
cmdEscribir.Enabled = False
cmdLeer.Enabled = False
modus = "escribir"
txtGetal.Locked = False
cmdSiguiente.Enabled = True
start
End Sub
Private Sub cmdLeer_Click()
cmdEscribir.Enabled = False
cmdLeer.Enabled = False
modus = "leer"
txtGetal.Locked = True
cmdSiguiente.Enabled = True
start
End Sub
Private Sub cmdOtravez_Click()
cmdOtravez.Visible = False
Unload Me
Load Me
End Sub
Private Sub cmdSiguiente_Click()
If modus = "escribir" Then
If txtGetal = enletras(getal) Then
aantalcorrect = aantalcorrect + 1
Else
MsgBox "No" & vbCrLf & enletras(getal), vbInformation
End If
If Not aantalcorrect = 0 Then lblScore.Caption = aantalcorrect * 100 /
aantalgemaakt & " %"
End If
start
End Sub
Private Sub txtGetal_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then cmdSiguiente_Click
End Sub
Private Sub txtInterval_Change()
interval = CInt(txtInterval.Text)
End Sub
Private Sub txtInterval_KeyPress(KeyAscii As Integer)
If Not IsInteger(txtNumero.Text & Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Private Sub txtMax_Change()
max = CInt(txtMax.Text)
End Sub
Private Sub txtMax_KeyPress(KeyAscii As Integer)
If Not IsInteger(txtNumero.Text & Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Private Sub txtMin_Change()
min = CInt(txtMin.Text)
End Sub
Private Sub txtMin_KeyPress(KeyAscii As Integer)
If Not IsInteger(txtNumero.Text & Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Private Sub txtNumero_Change()
aantaloef = CInt(txtNumero.Text)
cmdEscribir.Enabled = True
cmdLeer.Enabled = True
End Sub
Private Sub txtNumero_KeyPress(KeyAscii As Integer)
If Not IsInteger(txtNumero.Text & Chr(KeyAscii)) Then KeyAscii = 0
End Sub
Sub start()
If min + interval * aantaloef > max Then
MsgBox "No puedo generar estos ejercicios." & vbCrLf & "Vuelve a definir el
mínimo, el máximo, el interval y el número de ejercicios", vbCritical
cmdEscribir.Enabled = True
cmdLeer.Enabled = True
modus = ""
txtGetal.Locked = True
cmdSiguiente.Enabled = False
Exit Sub
End If
aantalgemaakt = aantalgemaakt + 1
If Not aantalgemaakt > aantaloef Then Me.lblProgreso = aantalgemaakt & "/" &
aantaloef
If modus = "leer" And aantalgemaakt = aantaloef Then
cmdSiguiente.Enabled = False
cmdOtravez.Visible = True
End If
If modus = "escribir" And aantalgemaakt + 1 = aantaloef Then
Exit Sub
cmdOtravez.Visible = True
End If
Randomize
If max = 0 Then max = 5000
If interval = 0 Then interval = 1
Do
getal = ((min + Rnd * (max - min)) \ interval) * interval
Loop While IsGekozen(getal)
lblGetal.Caption = getal
txtGetal.Text = ""
If modus = "leer" Then txtGetal.Text = enletras(getal)
If modus = "escribir" And aantalgemaakt > aantaloef Then
cmdSiguiente.Enabled = False
MsgBox Me.lblScore.Caption
End If
End Sub
Function IsGekozen(getal) As Boolean
Dim t As Integer
For t = 1 To 1000
If gekozen(t) = getal Then
IsGekozen = True
Exit Function
End If
Next t
gekozen(aantalgemaakt) = getal
End Function
En voor de functies van het uitschrijven:
Function simple(ByVal numero As Integer) As String
Select Case numero
Case 1
simple = "uno"
Case 2
simple = "dos"
Case 3
simple = "tres"
Case 4
simple = "cuatro"
Case 5
simple = "cinco"
Case 6
simple = "seis"
Case 7
simple = "siete"
Case 8
simple = "ocho"
Case 9
simple = "nueve"
Case 10
simple = "diez"
Case 11
simple = "once"
Case 12
simple = "doce"
Case 13
simple = "trece"
Case 14
simple = "catorce"
Case 15
simple = "quince"
Case 16
simple = "dieciséis"
Case 17
simple = "diecisiete"
Case 18
simple = "dieciocho"
Case 19
simple = "diecinueve"
Case 20
simple = "veinte"
Case 30
simple = "treinta"
Case 40
simple = "cuarenta"
Case 50
simple = "cincuenta"
Case 60
simple = "sesenta"
Case 70
simple = "setenta"
Case 80
simple = "ochenta"
Case 90
simple = "noventa"
End Select
End Function
Function triple(ByVal numero As Integer) As String
Dim h As Integer
Dim t As Integer
Dim e As Integer
e = numero Mod 10
h = (numero \ 100) * 100
t = numero - h - e
If Not simple(t + e) = "" Then
triple = simple(t + e)
Else
triple = simple(t) & " y " & simple(e)
If t = 0 And e = 0 Then triple = ""
End If
Select Case h
Case 100
If triple = "" Then
triple = "ciento"
Else
triple = "ciento " & triple
End If
Case 200
If triple = "" Then
triple = "doscientos"
Else
triple = "doscientos " & triple
End If
Case 300
If triple = "" Then
triple = "trescientos"
Else
triple = "trescientos " & triple
End If
Case 400
If triple = "" Then
triple = "cuantrocientos"
Else
triple = "cuatrocientos " & triple
End If
Case 500
If triple = "" Then
triple = "quinientos"
Else
triple = "quinientos " & triple
End If
Case 600
If triple = "" Then
triple = "seiscientos"
Else
triple = "seiscientos " & triple
End If
Case 700
If triple = "" Then
triple = "setecientos"
Else
triple = "setecientos " & triple
End If
Case 800
If triple = "" Then
triple = "ochocientos"
Else
triple = "ochocientos " & triple
End If
Case 900
If triple = "" Then
triple = "novecientos"
Else
triple = "novecientos " & triple
End If
End Select
End Function
Function enletras(ByVal numero As Long) As String
If numero = 0 Then enletras = "cero"
Dim millon As Integer
Dim mil As Integer
Dim un As Integer
Dim buffer As Long
millon = numero \ 1000000
buffer = numero - millon * 1000000
mil = buffer \ 1000
buffer = buffer - mil * 1000
un = buffer
Select Case millon
Case 1
enletras = "un millón"
Case Is > 1
enletras = simple(m) & " millones"
End Select
If millon > 0 And mil > 0 Then enletras = enletras & " "
Select Case mil
Case 1
enletras = enletras & "mil"
Case Is > 1
enletras = enletras & triple(mil) & " mil"
End Select
If mil > 0 And un > 0 Then enletras = enletras & " "
enletras = enletras & triple(un)
End Function
Zie ook: NameNumbers (een uitwerking in het Engels)