Code zu Mathematik und Geometrie in Classic Visual Basic
- Ermitteln von Zufallszahlen in angegebenem Intervall
- Ermitteln des größten gemeinsamen Teilers zweier Zahlen
- Ungenaues Berechnen von π
- Ziehen beliebiger Wurzeln
- Umwandeln einer Zahl in eine Binärzeichenfolge
- Bestimmen von Minimum und Maximum in einem Array
Ermitteln von Zufallszahlen in angegebenem Intervall
Um ganzzahlige Zufallszahlen in einem angegebenen Intervall zu ermitteln, kann folgende Funktion verwendet werden. Dabei wird der von der Funktion Rnd
zurückgegebene Wert über dem Intervall skaliert:
Private Function GetRandomNumber( _
ByVal Minimum As Long, _
ByVal Maximum As Long _
) As Long
GetRandomNumber = Rnd * (Maximum - Minimum) + Minimum
End Function
Ermitteln des größten gemeinsamen Teilers zweier Zahlen
Die folgende Funktion berechnet den größten gemeinsamen Teiler zweier Zahlen und gibt ihn zurück:
'
' Calculates the greatest common divider for two numbers.
'
Private Function GCD( _
ByVal Number1 As Long, _
ByVal Number2 As Long _
) As Long
' Sort numbers, after this call 'Number2' contains the
' larger number of the two numbers, 'Number1' the smaller
' one.
If Number2 < Number1 Then
Dim n As Long
n = Number2
Number2 = Number1
Number1 = n
End If
' 'Number1' contains the smallest number. The first two
' statements inside the loop will change this and place the
' value of 'Remainder' in 'Number2'. Which is supposed
' to be the smallest.
Dim Remainder As Long
Remainder = Number1
Do While Remainder > 1
' The remainder of the division is always the smallest
' number and thus must be stored in 'Number2'.
Number1 = Number2
Number2 = Remainder
Remainder = Number1 Mod Number2
Loop
' Return value.
If Remainder = 0 Then
GCD = Number2
Else
GCD = Remainder
End If
End Function
Ungenaues Berechnen von π
Bei mathematischen Berechnungen, beispielsweise in der Trigonometrie, benötigt man oft den Wert der Kreiszahl π. Dieser kann in meist ausreichender Genauigkeit über die im Folgenden angegebene kleine Funktion berechnet werden. Sinnvollerweise sollte π nur ein Mal berechnet und dann wiederverwendet werden, damit die Laufzeit des Programms verbessert werden kann:
Private Function CalcPi() As Double
CalcPi = 4 * Atn(1)
End Function
Ziehen beliebiger Wurzeln
Die meisten Programmiersprachen stellen eine Funktion zur Berechnung der Quadratwurzel einer Zahl zur Verfügung. Zur Berechnung der -ten Wurzel aus einer Zahl kann man darauf zurückgreifen, daß die -te (Wurzelexponent) Wurzel aus (Radikand) gleich ist. Dies läßt sich leicht in eine eigene Funktion namens Root
packen:
Private Function Root( _
ByVal Radicand As Double, _
ByVal RootExponent As Double _
) As Double
Root = Radicand ^ (1 / RootExponent)
End Function
Die Funktion Root
zieht also die RootExponent
-te Wurzel aus Radicand
und gibt das Ergebnis zurück. Der Aufruf könnte dann folgendermaßen erfolgen:
Result = 0.25 + Root(16, a) * 4711
Es ist zu beachten, daß das Ziehen der Quadratwurzel aus einer Zahl über die Visual-Basic-eigene Sqr
-Funktion bedeutend schneller durchgeführt wird, als von der oben beschriebenen Funktion Root
.
Umwandeln einer Zahl in eine Binärzeichenfolge
Um eine Zahl in einen Binärstring, bestehend aus den Zeichen 0
, 1
und -
umzuwandeln, bietet sich diese rekursive Funktion an. Die Funktion behandelt keine Vorzeichenbits, sondern fügt der Zahl an erster Stelle ein Minus hinzu, wenn es sich um eine negative Zahl handelt:
Private Function DecToBin(ByVal Number As Long) As String
If Abs(Number) > 1 Then
DecToBin = DecToBin(Number \ 2) & CStr(Abs(Number Mod 2))
Else
DecToBin = CStr(Number)
End If
End Function
Ein möglicher Aufruf könnte wie folgt aussehen:
Debug.Print DecToBin(1982)
Debug.Print DecToBin(-4711)
Eine iterative Version könnte so aussehen:
Private Function DecToBin(ByVal Number As Long) As String
Dim Absolute As Long
Absolute = Abs(Number)
If Absolute >= 2 ^ 31 Then
DecToBin = "OVERFLOW"
Else
Dim i As Long
Absolute = Abs(Number)
Do
If (Absolute And 2 ^ i) = 2 ^ i Then
DecToBin = "1" & DecToBin
Else
DecToBin = "0" & DecToBin
End If
i = i + 1
Loop Until 2 ^ i > Absolute
End If
If Number < 0 Then
DecToBin = "-" & DecToBin
End If
End Function
Bestimmen von Minimum und Maximum in einem Array
Folgende Funktionen geben das Minimum und das Maximum in einem Array zurück. Das Eingangsarray ist als Variant
deklariert, sodaß das Beispiel mit verschiedenen Elementdatentypen funktioniert (Min("Modem", "Harddisk", "Mouse", "Computer") = "Computer"
und Min(3, -5, 0, 9) = -5
). Die Funktionen verfügen über zwei Parameter, sodaß mindestens ein Wert an die Funktionen übergeben werden muß:
Private Sub Main()
Call MsgBox( _
"Min(""Modem"", ""Harddisk"", ""Mouse"", ""Computer"") = " & _
"""" & _
Min("Modem", "Harddisk", "Mouse", "Computer") & _
"""" & vbNewLine & _
vbNewLine & _
"Max(""Modem"", ""Harddisk"", ""Mouse"", ""Computer"") = " & _
"""" & _
Max("Modem", "Harddisk", "Mouse", "Computer") & _
"""" _
)
Call MsgBox( _
"Min(3, -5, 0, 9) = " & _
Min(3, -5, 0, 9) & vbNewLine & _
vbNewLine & _
"Max(3, -5, 0, 9) = " & _
Max(3, -5, 0, 9) _
)
End Sub
'
' Minimum bestimmen.
'
Private Function Min( _
ByVal Item As Variant, _
ParamArray Items() As Variant _
) As Variant
Dim i As Long
For i = 0 To UBound(Items)
If Items(i) < Item Then
Item = Items(i)
End If
Next i
Min = Item
End Function
'
' Maximum bestimmen.
'
Private Function Max( _
ByVal Item As Variant, _
ParamArray Items() As Variant _
) As Variant
Dim i As Long
For i = 0 To UBound(Items)
If Items(i) > Item Then
Item = Items(i)
End If
Next i
Max = Item
End Function