vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 
zurück
Rubrik: Variablen/Strings   |   VB-Versionen: VB.NET16.05.07
Der CType-Operator in VB 2005

Erstellung von Klassen, die wie integrierte Datentypen verwendet werden können.

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  10.194 
ohne HomepageSystem:  WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10kein Beispielprojekt 

Durch den CType-Operator lassen sich in VB 2005 Klassen erstellen, die im Code wie integrierte Datentypen verwendet werden können.

Als Beispiel dient die Klasse 'cDouble'.
Diese Klasse kapselt einen Double-Wert und stellt Operatoren für die vier Grundrechenarten zur Verfügung. Da in VB.Net die IEEE-kompatiblen Gleitkomma-Variablen (SINGLE, DOUBLE) keine Ausnahme auslösen, wenn es zu einem Überlauf oder einer Division durch 0 kommt, ist in diesen Fällen die Ausnahme 'Overflow' - entsprechend dem 'klassischen' VB-Verhalten - in 'cDouble' wieder integriert worden ('DivideByZero' wird jedoch ebenfalls als 'Overflow' gemeldet).

Durch geeignete Belegung der klassenglobalen Konstanten 'cMinValue' und 'cMaxValue' kann der akzeptierte Wertebereich der cDouble-Instanzen weiter eingegrenzt werden.
Dies ist nützlich bei der Modellierung. Hat man z.B. Variable, die Temperatur-Angaben enthalten sollen, ist es vermutlich zweckmäßig, den Wertebereich dieser Klasse von Variablen auf +/-50 einzugrenzen.

Die Vergleichsoperatoren der Klasse 'cDouble' führen ausprägungsabhängige Epsilon-Vergleiche durch. Welches Werteintervall dabei als 'gleich' akzeptiert wird, kann durch die klassenglobale Konstante 'cEpsilon' gesteuert werden.

Die Routine 'cDouble_Demo' zeigt die Verwendung der Klasse 'cDouble' im VB-Code.

Man beachte, dass weder das Schlüsselwort NEW bei der Erstellung eines Instanz, noch die explizite Konvertierung von numerischen Datentypen bei der Zuweisung erforderlich ist. Nur bei Zuweisung einer String-Variable mit numerisch darstellbarem Inhalt ist eine Konvertierung nötig (wegen 'OPTION STRICT ON').

Die mathematischen Funktionen in der Klasse MATH können von cDouble-Instanzen direkt verwendet werden. Falls man das Funktions-Ergebnis wieder auf eine cDouble-Instanz zuweist, wird beim Auftreten von IEEE-Sonderwerten der Overflow-Error ausgelöst.

Auch (z.B. mehrdimensionale) Arrays können aus Instanzen der Klasse 'cDouble' gebildet werden und sind im Code wie Double-Arrays verwendbar.

' =======================================================
' Klasse kapselt einen Double-Wert
' Fehler Overflow bei Wertebereichs-überschreitung 
' Verhalten imitiert integrierten VB-Datentyp
' =======================================================
' Mai 2007
' Manfred Bohn für VBARCHIV
 
Option Strict On
Option Explicit On
 
Public Class cDouble
 
  ' gekapselter Double-Wert
  Dim gDouble As Double
 
  ' zugelassene Werte-Limits:
  ' hier können auch bei Bedarf engere
  ' Beschränkungen vorgegeben werden
  Shared cMaxValue As Double = Double.MaxValue
  Shared cMinValue As Double = Double.MinValue
 
  ' relatives Epsilon für Wertvergleiche
  Shared cEpsilon As Double = 0.000001
  ' ================================================
  ' Konstruktoren
  ' ================================================
  Public Sub New()
    ' Standardkonstruktor 
    gDouble = 0.0
  End Sub
 
  Public Sub New(ByVal dbl As Double)
    ' Konstruktor mit Zuweisungsfunktion
    ' Initialisierung
    gDouble = 0.0
    Let_Value(dbl)
  End Sub
  ' ================================================
  ' Wertabfrage und Zuweisung (explizit)
  ' ================================================
  Public Sub Let_Value(ByVal dbl As Double)
    If Not CheckDouble(dbl) Then
      ' nur zugelassene Werte akzeptieren
      Throw New System.OverflowException
    Else
      ' Zuweisung
      gDouble = dbl
    End If
  End Sub
 
  Public Function Get_Value() As Double
    ' Wert-Abfrage
    Return gDouble
  End Function
  ' ====================================================
  ' klassenglobal vereinbarte Limits der Werteausprägung
  ' ====================================================
  Public Shared ReadOnly Property MinValue() As Double
    Get
      Return cMinValue
    End Get
  End Property
 
  Public Shared ReadOnly Property MaxValue() As Double
    Get
      Return cMaxValue
    End Get
  End Property
  ' ======================================================
  ' Limitüberprüfung (angewendet bei allen Parametern)
  ' ======================================================
  Private Shared Function CheckDouble(ByVal dbl As Double) As Boolean
    ' Wertebereich des Double prüfewn und 
    ' ggf. Fehler auslösen
 
    ' Durch diese Abfrage werden Infinity/Nan-Werte
    ' erkannt, ohne dass auf die entsprechenden 
    ' Double-Methoden 'IsNan', 'IsInfinity' 
    ' zurückgegriffen werden muss
    If dbl <= cMaxValue And _
      dbl >= cMinValue Then
      Return True
    Else
      Return False
    End If
  End Function
  Public Shared Widening Operator CType( _
    ByVal cdb As cDouble) As Double
 
    ' beliebige numerische Datentypen 
    ' können den Inhalt der Instanz von 
    ' cDouble aufnehmen, falls numerisch möglich
    ' ggf. nach impliziter Konvertierung
    Return cdb.Get_Value
  End Operator
 
  Public Shared Widening Operator CType( _
    ByVal dbl As Double) As cDouble
 
    ' beliebige numerische Werte können
    ' falls numerisch zulässig - in eine (neue) Instanz 
    ' von cDouble eingetragen werden (als Double-Wert)
    Dim erg As New cDouble(dbl)
    Return erg
  End Operator
  ' =========================================================
  ' Vergleichsoperatoren (Epsilon-Vergleich !!)
  ' =========================================================
  Public Shared Operator =( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    ' Epsilon-Vergleich von 2 Werten
    Return IsEqual(cdb1.Get_Value, cdb2.Get_Value)
  End Operator
 
  Public Shared Operator <>( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    Return (Not IsEqual(cdb1.Get_Value, cdb2.Get_Value))
  End Operator
 
  Public Shared Operator >( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    If Not IsEqual(cdb1.Get_Value, cdb2.Get_Value) Then
      Return cdb1.Get_Value > cdb2.Get_Value
    Else
      Return False
    End If
  End Operator
 
  Public Shared Operator <( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    If Not IsEqual(cdb1.Get_Value, cdb2.Get_Value) Then
      Return cdb1.Get_Value < cdb2.Get_Value
    Else
      Return False
    End If
  End Operator
 
  Public Shared Operator >=( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    If IsEqual(cdb1.Get_Value, cdb2.Get_Value) Then
      Return True
    Else
      Return cdb1 > cdb2
    End If
  End Operator
 
  Public Shared Operator <=( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As Boolean
 
    If IsEqual(cdb1.Get_Value, cdb2.Get_Value) Then
      Return True
    Else
      Return cdb1 < cdb2
    End If
  End Operator
  Private Shared Function IsEqual(ByVal dbl1 As Double, _
    ByVal dbl2 As Double) As Boolean
 
    ' allgemeine Hilfsfunktion: Vergleichsoperatoren 
    ' Epsilon-Vergleich von 2 Double-Werten
 
    Dim Min_Eps As Double = Double.Epsilon * 10
    Dim eps As Double = _
      cEpsilon * Math.Max(Math.Abs(dbl1), Math.Abs(dbl2))
 
    If eps < Min_eps Then eps = Min_Eps
    If dbl1 > eps And dbl2 < -eps Then
      Return False
    ElseIf dbl1 < -eps And dbl2 > eps Then
      Return False
    Else
      Return Math.Abs(dbl1 - dbl2) <= eps
    End If
  End Function
  ' ===========================================================
  ' Arithmetische Operatoren
  ' ===========================================================
  Public Shared Operator +( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As cDouble
 
    Dim erg As New cDouble
    erg.Let_Value(cdb1.Get_Value + cdb2.Get_Value)
    Return erg
  End Operator
 
  Public Shared Operator -( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As cDouble
 
    Dim erg As New cDouble
    erg.Let_Value(cdb1.Get_Value - cdb2.Get_Value)
    Return erg
  End Operator
 
  Public Shared Operator *( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As cDouble
 
    Dim erg As New cDouble
    erg.Let_Value(cdb1.Get_Value * cdb2.Get_Value)
    Return erg
  End Operator
 
  Public Shared Operator /( _
    ByVal cdb1 As cDouble, _
    ByVal cdb2 As cDouble) As cDouble
 
    Dim erg As New cDouble
    erg.Let_Value(cdb1.Get_Value / cdb2.Get_Value)
    Return erg
 
  End Operator
End Class
' =================================================================
' Ende der Klasse 'cDouble'
' =================================================================

Demonstrationsroutine

Public Sub cDouble_Demo()
  ' Routine zur Demonstration der Klasse 'cDouble'
 
  Dim lng1, lng2 As Long               ' Long
  Dim str_lng As String                ' String-Variable
  Dim dbl1, dbl2, dbl_erg As Double    ' Double
 
  Dim cdb1, cdb2, cdbl_erg As cDouble  ' cDouble-Instanzen
 
  Dim dbl_arr(,) As Double             ' Double-Array 
  Dim cdb_arr(,) As cDouble            ' cDouble-Array
 
  Dim i As Integer                     ' Loop
  Dim d1, d2 As Integer                ' Array-Loops
 
  ' Test-Durchläufe
  For i = 1 To 1000000
 
    ' 2 zufällige Double-Werte
    dbl1 = Random_Double()
    dbl2 = Random_Double()
    If dbl2 = 0 Then dbl2 = 1 ' 0 vermeiden
 
    ' Manchmal sind beide Werte gleich
    If i Mod 100 = 0 Then dbl2 = dbl1
 
    ' Zuweisung der Zufallswerte auf cDouble-Instanzen
    cdb1 = dbl1
    cdb2 = dbl2
 
    ' typreine Additionen und Ergebnisvergleich
    cdbl_erg = cdb1 + cdb2
    dbl_erg = dbl1 + dbl2
    If dbl_erg <> cdbl_erg Then Stop
 
    ' typgemischte Subtraktionen und Ergebnisvergleich
    cdbl_erg = cdb1 + dbl2
    dbl_erg = dbl1 + cdb2
    If dbl_erg <> cdbl_erg Then Stop
 
    ' typreine Multiplikation
    cdbl_erg = cdb1 * cdb2
    dbl_erg = dbl1 * dbl2
    If dbl_erg <> cdbl_erg Then Stop
 
    If Math.Abs(dbl2) > 0 Then
      ' typgemischte Divisionen und Ergebnisvergleich
      cdbl_erg = dbl1 / cdb2
      dbl_erg = cdb1 / dbl2
      If dbl_erg <> cdbl_erg Then Stop
    End If
 
    ' Vergleichsoperatoren:
    ' Double-Vergleich muss cDouble-Vergleich entsprechen 
    If (dbl1 > dbl2) <> (cdb1 > cdb2) Then Stop
    If (dbl1 < dbl2) <> (cdb1 < cdb2) Then Stop
 
    If (dbl1 >= dbl2) <> (cdb1 >= cdb2) Then Stop
    If (dbl1 <= dbl2) <> (cdb1 <= cdb2) Then Stop
 
    If (dbl1 <> dbl2) <> (cdb1 <> cdb2) Then Stop
    If (dbl1 = dbl2) <> (cdb1 = cdb2) Then Stop
 
    ' Verwendung von MATH-Funktionen
    If Math.Sqrt(Math.Abs(dbl1)) <> _
      Math.Sqrt(Math.Abs(cdb1)) Then Stop
    If Math.Pow(Math.Abs(dbl1), 0.55) <> _
      Math.Pow(Math.Abs(cdb1), 0.55) Then Stop
    If Math.Round(dbl1, 5) <> _
      Math.Round(cdb1, 5) Then Stop
    If Math.Truncate(dbl1) <> _
      Math.Truncate(cdb1) Then Stop
 
    ' 2 zufällige Long-Werte
    lng1 = CLng(10000 * Rnd())
    lng2 = CLng(1000000 * Rnd())
    If lng2 = 0 Then lng2 = 1 ' 0 vermeiden
 
    ' Umwandlung in einen String
    str_lng = CStr(lng1)
 
    ' Zuweisung eines numerischen Strings auf cDouble
    cdb1 = CDbl(str_lng)
 
    ' Zuweisung eines Long-Wertes auf cDouble
    cdb2 = lng2
 
    ' Ergebnisvergleich nach typgemischter Addition 
    If lng1 + cdb2 <> cdb2 + lng1 Then Stop
    If lng1 / cdb2 <> cdb1 / lng2 Then Stop
 
    ' cDouble-Array
    ReDim cdb_arr(10, 20)
    ' Double-Array
    ReDim dbl_arr(UBound(cdb_arr, 1), UBound(cdb_arr, 2))
 
    For d1 = 0 To UBound(cdb_arr, 1)
      For d2 = 0 To UBound(cdb_arr, 2)
        ' Arrays füllen
        cdb_arr(d1, d2) = Rnd()
        dbl_arr(d1, d2) = cdb_arr(d1, d2)
      Next d2
    Next d1
 
    cdb1 = 0 : cdb2 = 0 ' für Summation
    For d1 = 0 To UBound(cdb_arr, 1)
      For d2 = 0 To UBound(cdb_arr, 2)
        ' Inhalt der Arrays vergleichen
        If cdb_arr(d1, d2) <> dbl_arr(d1, d2) Then Stop
        ' Summation der Felder in cDouble-Instanzen
        cdb1 += cdb_arr(d1, d2)
        cdb2 += dbl_arr(d1, d2)
      Next d2
    Next d1
 
    ' Vergleich der Feld-Summen beider Arrays
    If cdb1 <> cdb2 Then Stop
 
    ' nächster Durchlauf
  Next i
End Sub
Public Function Random_Double() As Double
  ' zufälliger Double-Wert im Bereich 
  ' -1E30 bis +1E30
 
  Dim x As Double = Rnd() * 1.0E+30
  If Rnd() > 0.5 Then x = -x
  Return x
End Function

Dieser Tipp wurde bereits 10.194 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen [email protected]  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren [email protected]!
- 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.
 
   

Druckansicht Druckansicht Copyright ©2000-2022 [email protected] Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel