Der Datentyp 'Decimal', der in VB6 als Untertyp des Datentyps Variant zur Verfügung steht, erlaubt nicht nur die Durchführung von Berechnungen mit 28-stelliger Genauigkeit. Die VB-Operatoren für ganzzahlige Division ('\') und für ganzzahligen Divisionsrest ('MOD') akzeptieren nur Parameter, die Daten enthalten, die im numerischen Geltungsbereich des Datentyps 'LONG' liegen. Entsprechend der Arbeitsweise der VB-Operatoren '\' und 'MOD' gilt auch für die Ersatzfunktionen DDIV und DMOD: Wenn mindestens ein Ausdruck ein 'Null'-Ausdruck ist, enthält das Ergebnis ebenfalls 'Null'. Wenn ein Ausdruck den Wert 'Empty' hat, wird er als 0 interpretiert. Liegt ein Parameter oder ein berechneter Wert ausserhalb der zulässigen Spannweite für DECIMAL, wird der 'Überlauf'-Fehler ausgelöst, bei 0-Divisoren wird der 'Division durch Null'-Fehler. Diese Fehler können durch eine 'ON ERROR GOTO'-Anweisung im rufenden Programm verarbeitet werden. Die Demo-Routine 'DECIMAL_DIV_DEMO' überprüft zunächst mit Zufallszahlen des Typs LONG, ob die Ersatzfunktionen die gleichen Ergebnisse wie die VB-Operationen liefern. ' ================================================================= ' Start Quellcode Modul 'modDecimalDiv' ' ================================================================= Option Explicit Sub DECIMAL_DIV_DEMO() ' Demonstration der Funktionen DDIV und DMOD Dim du As Long ' Zahl der Test-Durchgänge Dim i As Long ' Loop Dim lngDivident As Long ' zufällige Werte Dim lngDivisor As Long ' für Division Dim varDivident As Variant ' zufällige Werte Dim varDivisor As Variant ' für Division (DECIMAL) Dim MOD_ERG As Long ' Speicher für Dim DMOD_ERG As Variant ' Operations-Ergebnisse Dim DIV_ERG As Long Dim DDIV_ERG As Variant du = 10000 ' Anzahl der Test-Durchgänge festlegen ' Vergleich der VB-Operationen mit den ' beiden Ersatzfunktionen ' (Zufallswerte innerhalb LONG-Spannweite) For i = 1 To du ' Zwei zufällige Werte erstellen lngDivident = GetRandomLong lngDivisor = GetRandomLong While Abs(lngDivisor) < 0.000000001 lngDivisor = GetRandomLong Wend ' VB-Operation: MOD MOD_ERG = lngDivident Mod lngDivisor ' Ersatzfunktion (Parameter-Typen sind flexibel wählbar) DMOD_ERG = DMOD(CStr(lngDivident), CCur(lngDivisor)) ' Vergleich der beiden Ergebnisse If DMOD_ERG <> MOD_ERG Then MsgBox "DMOD scheitert": Exit Sub End If ' VB-Operation: \ DIV_ERG = lngDivident \ lngDivisor ' Ersatzfunktion DDIV_ERG = DDIV(lngDivident, lngDivisor) ' Vergleich der beiden Ergebnisse If DIV_ERG <> DDIV_ERG Then MsgBox "DDIV scheitert": Exit Sub End If ' Rückrechnung durchführen If DDIV_ERG * lngDivisor + DMOD_ERG <> lngDivident Then MsgBox "Rückrechnung fehlerhaft": Exit Sub End If Next i ' Ersatzfunktionen für Werte innerhalb der ' Spannweite DECIMAL testen For i = 1 To du ' Zwei zufällige Werte erstellen varDivident = Round(GetRandomDecimal, 0) varDivisor = Round(GetRandomDecimal, 0) While Abs(varDivisor) < 0.00000000000001 varDivisor = Round(GetRandomDecimal, 0) Wend ' Ersatzfunktionen anwenden DMOD_ERG = DMOD(varDivident, varDivisor) DDIV_ERG = DDIV(varDivident, varDivisor) ' Rückrechnung durchführen If DDIV_ERG * varDivisor + DMOD_ERG <> varDivident Then MsgBox "Rückrechnung fehlerhaft (DECIMAL)": Exit Sub End If Next i MsgBox "Test erfolgreich abgeschlossen", vbInformation End Sub Public Function DMOD(ByVal number As Variant, _ ByVal div As Variant) As Variant ' Modulo-Division (Basis: Datentyp Decimal) ' Ergebnis entsprechend der VB-Operation: ' DMOD = number MOD div Dim tmp As Variant Dim vzn As Variant ' Sonderfälle analog VB-Operatoren If IsNull(number) Then DMOD = Null: Exit Function If IsNull(div) Then DMOD = Null: Exit Function If IsEmpty(number) Then number = 0 If IsEmpty(div) Then div = 0 ' nur numerisch interpretierbare ' Argumente akzeptieren If Not IsNumeric(number) Or Not IsNumeric(div) Then Exit Function ' Vorzeichen registrieren vzn = Sgn(number) ' Argumente in ganzzahlige Decimal-Werte wandeln ' (absolute Ausprägung) number = Abs(Round(CDec(number), 0)) div = Abs(Round(CDec(div), 0)) If div = 0 Then Err.Raise 11 Exit Function End If ' Division durchführen ... tmp = Int(number / div) ' ... zurückrechnen tmp = tmp * div ' vorzeichenbehafteten ' Divisionsrest berechnen DMOD = vzn * (number - tmp) End Function Public Function DDIV(ByVal number As Variant, _ ByVal div As Variant) As Variant ' ganzzahlige Division (Basis: Datentyp Decimal) ' Ergebnis entsprechend der VB-Operation: ' DDIV = number \ div ' Sonderfälle analog VB-Operatoren If IsNull(number) Then DDIV = Null: Exit Function If IsNull(div) Then DDIV = Null: Exit Function If IsEmpty(number) Then number = 0 If IsEmpty(div) Then div = 0 ' nur numerisch interpretierbare ' Argumente akzeptieren If Not IsNumeric(number) Or Not IsNumeric(div) Then Exit Function If Abs(div) = 0 Then ' Division durch Null Err.Raise 11 Exit Function End If ' Division durchführen ' und Divisions-Rest abschneiden DDIV = Fix(CDec(number) / CDec(div)) End Function Private Function GetRandomDecimal() As Variant ' Zufallszahl innerhalb Spannweite 'DECIMAL' Dim l As Long ' Länge der Ziffernfolge Dim bs As String ' Ziffernfolge Dim z As Long ' zufällige Ziffer Dim k As Long ' Loop Dim dec As Variant ' zufällige Länge der Ziffernfolge: 1-27 l = Rnd * 26 + 1 ' zufällige Ziffernfolge erzeugen bs = String(l, " ") For k = 1 To l z = CInt(Rnd * 9) Mid$(bs, k, 1) = CStr(z) Next k ' zufälliges Vorzeichen hinzufügen If Rnd > 0.5 Then bs = "-" + bs dec = CDec(1) If Rnd > 0.1 Then dec = CDec(10) ^ Int(Rnd * l) End If ' Variant/Decimal erstellen GetRandomDecimal = CDec(bs) / dec End Function Private Function GetRandomLong() As Long ' Zufallszahl innerhalb Spannweite 'LONG' Dim lng As Long lng = Rnd * (2.12 ^ 9) If Rnd > 0.5 Then lng = -lng GetRandomLong = lng End Function ' ================================================================= ' Ende Quellcode Modul 'modDecimalDiv' ' ================================================================= Dieser Tipp wurde bereits 9.122 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |