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.121 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. |
sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) 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. |