vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Variablen/Strings · Sonstiges   |   VB-Versionen: VB608.08.05
Beschränkte Variable

Klasse für eine Variable, die benutzerdefinierten Beschränkungen unterliegt

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  20.481 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Beschränkte Variable = eine Variable, die benutzerdefinierten Restriktionen unterliegt.

Der Bereich der möglichen Wert-Ausprägungen, die auf eine numerische Variable in VB zugewiesen werden können, ist abhängig von der Zahl der Bytes, die der Datentyp im Speicher belegt und von der Formatierung (IEEE bei Single, Double) bzw. der Skalierung (bei Integer, Long, Currency) des Datentyps.

Es ist nicht möglich, bei der Deklaration einer Variable auf deren zulässige Wert-Spannweite Einfluß auszuüben - abgesehen von der Wahl des Datentyps.
Häufig wären solche Einschränkungen auf einen sachlich plausiblen Werte-Bereich zweckmäßig. Z.B. wird man eine Temperaturangabe (in Celsius-Graden) durch eine Gleitkommavariable des Type Single, Double oder evt. Currency erfassen. Sinnvolle Zuweisungen auf diese Variable können aber nur im Bereich von etwa -50,0° bis +50,0° liegen. Der Versuch der Zuweisung eines Wertes, der außerhalb dieses Intervalls liegt, sollte möglichst ein Warn-Ereignis oder einen Fehler auslösen. (Innerhalb der IDE kann man beim 'Debuggen' zwar 'Überwachungsausdrücke' für einzelne Variable hinzufügen, aber zur Laufzeit des ausführbaren Programms sind solche Kontrollen nicht möglich. Einige Standard-Überprüfungen bei Wert-Zuweisungen können durch das Setzen der entsprechenden Compiler-Optionen sogar abgeschaltet werden.)

Bei Zuweisungen auf eine Variable verhält sich VB sehr tolerant. Wenn die Wert-Ausprägung im zulässigen Bereich der Ziel-Variable liegt, wird die Zuweisung auch durchgeführt. Dabei werden automatisch Datentypen umgewandelt und Zahlenwerte gerundet. Bei den folgenden Datentyp-Umwandlungen KANN es dabei zu Informationsverlusten kommen:

  • Decimal --> Double, Single, Currency, Long oder Integer
  • Double --> Single, Currency, Long oder Integer
  • Single --> Currency, Long oder Integer
  • Currency --> Double, Single, Long oder Integer
  • numerisch interpretierbarer String --> numerischer Datentyp

Dieses "typ-tolerante" Verhalten der Zuweisungs-Operationen ist manchmal unerwünscht, kann aber nicht einfach durch eine Option "abgeschaltet" werden. Um das Risiko des Informationsverlustes bei Berechnungen (und ggf. den Fehler 6 'Überlauf') auszuschließen, kann man z.B. einheitlich mit dem Datentyp DOUBLE (bzw. DECIMAL) arbeiten und Teilausdrücke explizit durch 'CDbl' (bzw. 'CDec') umwandeln.

Das VB-Verhalten bei der Auswertung von Ausdrücken ist gewöhnungsbedürftig. Die Datentypen der beteiligten Variablen UND die Art der Rechenoperationen entscheiden über den zurückgelieferten Datentyp des Ausdrucks. Die numerische Ausprägung des Ergebnisses der Berechnung wird nicht berücksichtigt. Sind alle Variable in einem Ausdruck ganzzahlig, ist auch das Ergebnis ganzzahlig - falls nur die Operationen Addition, Subtraktion, Multiplikation oder Ganzzahl-Division ausgeführt werden - sonst wird das Ergebnis als Gleitkommazahl geliefert - unabhängig davon, ob tatsächlich Nachkommastellen enthalten sind. Auch der Gleitkoma-Datentyp 'CURRENCY' liefert bei der Division einen DOUBLE-Wert. Die Ganzzahl-Operatoren arbeiten nur im Bereich des Datentyps LONG und liefern als Ergebnis immer eine Ganzzahl. Die meisten mathematischen VB-Funktionen liefern - unabhängig von Datentyp des Arguments - prinzipiell einen DOUBLE-Wert zurück.

VB initialisiert Variablen prinzipiell bei der Deklaration. Auch dieses Verhalten kann unerwünscht sein. Bei der Wertabfrage von Variablen, auf die noch kein Wert zugewiesen worden ist, sollte die Auslösung eines Fehler oder eines Warn-Ereignisses möglich sein.

Die Klasse clsXVar bietet die Möglichkeit der Deklaration einer "Variable" (= Instanz der Klasse 'clsXVar'), die während der Verwendung benutzer-definierten Beschränkungen unterliegt.

Die Erstellung einer Instanz dieser Klasse deklariert noch keine Variable, erst durch die Methode 'Dekl' wird die 'beschränkte' Variable deklariert.
Im ersten Argument dieser Methode ist der Datentyp der Variable festzulegen (als 'VBVarType'). Zulässig sind die Datentypen vbByte, vbInteger, vbLong, vbCurrency, vbSingle, vbDouble, vbDate, vbDecimal, vbString. (Zusätzlich kann durch 'vbUserDefinedType' eine 'Ganzzahl-Variable' im Geltungsbereich 'CURRENCY' deklariert werden.)

Im optionalen zweiten und dritten Argument (Variant) sind die zulässigen Werte-Limits anzugeben. Nur Werte innerhalb dieses Bereichs können später auf die Variable zugewiesen werden. Fehlt die Angabe der Untergrenze, wird die jeweils zulässige Datentyp-Untergrenze verwendet, bei fehlender Obergrenze die zulässige Datentyp-Obergrenze. Es ist nicht möglich Grenzen anzugeben, die diejenigen des Datentyps aus dem ersten Argument unter- bzw. überschreiten. Bei einer String-Variable geben die Parameter die geforderte Mindestlänge bzw. maximal zulässige Länge des zugewiesenen Strings an. Die zulässige Untergrenze für die String-Länge ist 0. Beim Datentyp 'Date' sind zwei Datums- oder Zeitangaben (Zeit-String oder DATE) erforderlich.

Im optionalen Argument 'Implizit' kann festgelegt werden, ob die Variable nur Zuweisungen des gleichen Datentyps erlaubt ('false' / Standard-Einstellung) oder ob die impliziten VB-Datentyp-Umwandlungen zulässig sind ('true'). Beim Argument 'Implizit' = 'false' können nur noch Variable des gleichen Datentyps zugewiesen werden oder Ausdrücke, die ggf. explizit in den geforderten Datentyp umgewandelt worden sind. Falls dieses Argument 'false' ist, wird bei der Zuweisung eines Wertes ausserhalb des zulässigen Geltungsbereichs eventuell nicht der Fehler 'Überlauf' sondern der übergeordnete Fehler 'falscher Datentyp' ausgelöst.

Das optionale Argument 'Initialisierung' bestimmt, ob die Variable bei der Deklaration initialisiert wird (numerisch = 0; String = Leer-String; Datum = 00:00:00 Uhr). Bei 'false' wird die Variable nach der Deklaration intern als 'Empty' belegt. Dieser Wert kann nicht abgefragt werden (siehe Eigenschaft 'Wert')! Es muss in diesem Fall zuvor eine gültige Wert-Zuweisung erfolgt sein.

Im optionalen Argument 'Fehler_Als_Ereignis' kann festgelegt werden, ob bei Zuweisungsfehlern durch die 'clsXVar'-Instanz ein Ereignis ('true') oder ein Fehler ('false' / Standard-Einstellung) ausgelöst wird. Die Belegung dieses Arguments mit 'true' ist natürlich nur dann sinnvoll, wenn die Klassen-Instanz modulglobal unter Verwendung des Schlüsselworts 'WithEvents' deklariert worden ist - oder ein Verweis auf eine entsprechende Variable gesetzt worden ist.

Im optionalen Argument 'Fehler_Ignorieren' kann festgelegt werden, dass Fehler bei der Zuweisung oder Abfrage des Wertes nicht ausgelöst werden ('true'). Die Verwendung dieser Option ist nicht sinnvoll!! Falls Fehler_Als_Ereignis = 'true' gesetzt ist, hat diese Option keine Wirkung.

Die Eigenschaft 'Wert' ermöglicht die kontrollierte Zuweisung und die Abfrage des aktuellen Wertes der als 'clsXVar' definierten Variable. Sie sollte als 'Voreinstellung' festgelegt werden (IDE -> Menü -> Extras -> Prozedurattribute -> Name "Wert" -> Weitere -> Prozedur-ID -> Voreinstellung). Beim Versuch der Abfrage des Wertes einer nicht-deklarierten oder nicht-initialisierten Variable wird ein Fehler (oder das Fehler-Ereignis) ausgelöst. Auf eine nicht-deklarierte Variable kann kein Wert zugewiesen werden ( --> Fehler oder Fehler-Ereignis).

Die schreibgeschützte Eigenschaft 'Restriktionen' erlaubt die Abfrage des Datentyps und der aktuell gesetzten Restriktionen (als optionale Rückgabe-Parameter).

Im rufenden Programm sollte stets eine Fehlerbehandlung aktiv sein, die die Fehler bei unzulässigen Zuweisungen auffängt und behandelt. Fehler, die bei der Deklaration der Variable auftreten, werden IMMER ausgelöst, unabhängig von den Parametern 'Fehler_Als_Ereignis' oder 'Fehler_Ignorieren'.

Im Einzelfall kann es sinnvoll sein, noch weitere spezifische Einschränkungen zu programmieren. Als Beispiel dafür ist in der Klasse 'clsXVAR' als zusätzliche Option bei String-Variablen die Restriktion des zulässigen ASCII-Bereichs der Zeichen hinzugefügt worden. Die schreibgeschützte Eigenschaft 'Ascii_Bereich' ermöglicht das (rückwirkende!) Setzen einer Unter- und Obergrenze, die bei Zuweisungen auf String-Variable beachtet werden. Beispiel: Nach Deklaration einer String-Variable und dem Aufruf der Methode 'Ascii_Bereich(asc(0), asc(9))' können nur noch Strings zugewiesen werden, die aus einer Ziffernfolge bestehen.

Denkbar sind weitere Einschränkungen, die bei Bedarf in die Klasse 'clsXVar' integriert werden können.
Einge Beispiele:

  • Beschränkung der zulässigen Anzahl der Abfragen eines zugewiesenen Wertes (die Zahl der Abfragen werden gezählt und beim Erreichen des Limits wird der Wert ungültig = NULL gesetzt);
     
  • zeitliche Beschränkung der Geltung eines Wertes (der Deklarations- oder der Zuweisungs-Zeitpunkt wird gespeichert und bei der Abfrage eines Wertes das inzwischen verstrichene Zeitintervall überprüft);
     
  • "dynamische Variable" (nach jeder Abfrage wird der gespeicherte Wert automatisch über eine Funktion umgerechnet).

Der Code des Formulars 'frmDemo_XVar' enthält zahlreiche Beispiele zur Deklaration und zur Verwendung von 'beschränkten Variablen' durch Instanzen der Klasse 'clsXVar'. Auch die Verwendung eines Arrays aus 'beschränkten Variablen' wird gezeigt.

' ============================================================================
' Start Quellcode Klasse 'clsXVar'
 
' Kapselung' einer VARIANT-Variable
' Überwachung von Datentyp und Ausprägung
' der Variable bei Zuweisung eines Wertes
' ============================================================================
Option Explicit
 
' Datentyp der Variable
Dim gDatenTyp As VbVarType
 
' zulässige Limits der Variable
Dim gUntergrenze As Variant
Dim gObergrenze As Variant
 
' Datentyp-Überwachung?
Dim gImplizit As Boolean
 
' numerischer Datentyp?
Dim gNumerisch As Boolean
 
' Zuweisungs-Fehler als Ereignis behandeln?
Dim gFehler_Als_Ereignis As Boolean
' Fehler auslösen oder ignorieren?
Dim gFehler_Ignorieren As Boolean
 
' Bereich zulässiger ASCII-Zeichen
' bei String-Variablen
Dim gAscii_UG As Byte
Dim gAscii_OG As Byte
 
' aktueller Wert der Variable
Dim gWert As Variant
 
' Ereignis:
' optionale Alternative zur Auslösung eines Fehlers
Public Event VariablenFehler(Fehler_Nummer As Long, _
  Quelle As String, _
  Beschreibung As String)
Private Sub Class_Initialize()
  Init
End Sub
Private Function Init() As Boolean
  ' Initialisierung der modulglobalen Kenn-Variablen
  gDatenTyp = Empty
  gUntergrenze = Empty
  gObergrenze = Empty
 
  ' Voreinstellungen
  gImplizit = False
  gFehler_Als_Ereignis = False
  gFehler_Ignorieren = False
 
  ' bei Strings: alle Ascii-Zeichen erlauben
  gAscii_UG = 0: gAscii_OG = 255
 
  ' Variable mit ungültigem Wert initialisieren
  gWert = Null
End Function
Public Function Dekl(ByVal Datentyp As VbVarType, _
  Optional ByVal Untergrenze As Variant = 0, _
  Optional ByVal Obergrenze As Variant = -1, _
  Optional ByVal Implizit As Boolean = False, _
  Optional ByVal Initialisierung As Boolean = True, _
  Optional ByVal Fehler_Als_Ereignis As Boolean = False, _
  Optional ByVal Fehler_Ignorieren As Boolean = False) As Boolean
 
  ' Deklaration der Variable
  Dim L_UG As Variant, L_OG As Variant
  Dim Numerisch As Boolean, FehlerNummer As Long
 
  On Error GoTo fehler
 
  ' zunächste Initialisierung durchführen
  Init
 
  ' Datentyp überprüfen, maximale Grenzen ermitteln
  If Not Datentyp_Limits(Datentyp, L_UG, L_OG, Numerisch) Then
    Err.Raise 13: Exit Function 'Typen unverträglich
  End If
 
  ' fehlende Beschränkung im Parameter
  ' --> maximale Grenzen des Datentyps erlauben
  If IsMissing(Untergrenze) Then gUntergrenze = L_UG
  If IsMissing(Obergrenze) Then gObergrenze = L_OG
 
  ' vorgegebene Wert-Beschränkung überprüfen
  If Datentyp = vbDate Then
    ' Datentyp: Date
    Untergrenze = CDate(Untergrenze)
    Obergrenze = CDate(Obergrenze)
    If DateDiff("s", Obergrenze, Untergrenze) > 0 Then
      gUntergrenze = L_UG: gObergrenze = L_OG
    Else
      If DateDiff("s", CDate(Untergrenze), L_UG) > 0 Or _
        DateDiff("s", CDate(Obergrenze), L_OG) < 0 Then
        ' Grenzen für DATE nicht geeignet
        Err.Raise 6
        Exit Function
      End If
    End If
  Else
    ' Datentyp: String oder numerisch
    If Not IsNumeric(Untergrenze) Or _
      Not IsNumeric(Obergrenze) Then
      Err.Raise 13
      Exit Function
    End If
    If Untergrenze > Obergrenze Then
      ' maximale Grenzen des Datentyps sind zulässig
      Untergrenze = L_UG: Obergrenze = L_OG
    Else
      If Untergrenze < L_UG Or Obergrenze > L_OG Then
        ' Grenzen für Datentyp nicht geeignet
        Err.Raise 6  'Überlauf
        Exit Function
      End If
    End If
  End If
 
  ' Zuweisung der Argumente auf modulglobale Variable
  gDatenTyp = Datentyp
  gImplizit = Implizit
  ' Grenzen festlegen
  If Datentyp = vbUserDefinedType Or Datentyp = vbString Then
    gUntergrenze = Round(Untergrenze, 0)
    gObergrenze = Round(Obergrenze, 0)
  Else
    If Not Trafo_Wert(Untergrenze, gUntergrenze, FehlerNummer) Then
      Err.Raise FehlerNummer: Exit Function
    End If
    If Not Trafo_Wert(Obergrenze, gObergrenze, FehlerNummer) Then
      Err.Raise FehlerNummer: Exit Function
    End If
  End If
 
  gFehler_Als_Ereignis = Fehler_Als_Ereignis
  gFehler_Ignorieren = Fehler_Ignorieren
  gNumerisch = Numerisch       ' numerischer Datentyp?
 
  ' Initialwert nach Deklaration
  gWert = Empty
 
  If Initialisierung Then
    ' optional: Initialisierung durchführen
    If gDatenTyp = vbString Then
      Trafo_Wert "", gWert
    Else
      Trafo_Wert 0, gWert
    End If
  End If
  Dekl = True
  Exit Function
 
fehler:
  ' bei einem Fehler: Instanz re-initialisieren
  Init   
End Function
Public Function Datentyp_Limits(ByVal Datentyp As VbVarType, _
  ByRef Untergrenze As Variant, _
  ByRef Obergrenze As Variant, _
  ByRef Numerisch As Boolean) As Boolean
 
  ' Hilfsfunktion: Dekl
  ' Ermittlung der maximal zulässigen Ausprägungen
  ' numerischer Datentypen in VB
  ' bei vbArray:  Deklarationsgrenzen
  ' bei vbString: String-Längen
 
  Datentyp_Limits = True: Numerisch = True
 
  If Datentyp = vbByte Then
    Untergrenze = CByte(0): Obergrenze = CByte(255)
  ElseIf Datentyp = vbInteger Then
    Obergrenze = CInt(32767)
    Untergrenze = CInt(-Obergrenze + 1)
  ElseIf Datentyp = vbLong Then
    Obergrenze = CLng(2147483647)
    Untergrenze = CLng(-Obergrenze - 1)
  ElseIf Datentyp = vbSingle Then
    Obergrenze = CSng(3.402823E+38)
    Untergrenze = -Obergrenze
  ElseIf Datentyp = vbDouble Then
    Obergrenze = CDbl(1.79769313486231E+308)
    Untergrenze = -Obergrenze
  ElseIf Datentyp = vbCurrency Then
    Obergrenze = CCur("922337203685477,5807")
    Untergrenze = CCur("-922337203685477,5808")
  ElseIf Datentyp = vbUserDefinedType Then
    Obergrenze = CCur("900000000000000")
    Untergrenze = -Obergrenze
  ElseIf Datentyp = vbDecimal Then
    Obergrenze = CDec("79228162514264337593543950335")
    Untergrenze = -Obergrenze
  ElseIf Datentyp = vbDate Then
    Untergrenze = CDate("1.1.100")
    Obergrenze = CDate("31.12.9999 23:59:59")
    Numerisch = False
  ElseIf Datentyp = vbString Then
    Untergrenze = CLng(0)      'Leerstring
    ' Obergrenze = 2 ^ 31  'maximal zulässige Anzahl Zeichen im String
    Obergrenze = CLng(2 ^ 16)
    Numerisch = False
  Else
    ' nicht unterstützter Datentyp
    Datentyp_Limits = False
    Untergrenze = Empty: Obergrenze = Empty
    Numerisch = False
  End If
End Function
Public Function Trafo_Wert(ByVal Arg As Variant, _
  ByRef wert As Variant, _
  Optional ByRef FehlerNummer As Long) As Boolean
 
  ' Hilfsfunktion: Dekl, Wert
  ' Das Argument 'Arg' wird per explizizter Typumwandlung
  ' in den Datentyp transformiert, der in 'gDatenTyp'
  ' festgelegt ist, und danach auf das Argument 'Wert' zugewiesen
 
  On Error GoTo fehler
  FehlerNummer = 0: wert = Empty
 
  If gDatenTyp = vbEmpty Then
    FehlerNummer = 45 'nicht deklariert
    Exit Function
  End If
 
  Select Case gDatenTyp
    Case vbByte
      wert = CByte(Arg)
    Case vbInteger
      wert = CInt(Arg)
    Case vbLong
      wert = CLng(Arg)
    Case vbCurrency
      wert = CCur(Arg)
    Case vbSingle
      wert = CSng(Arg)
    Case vbDouble
      wert = CDbl(Arg)
    Case vbDate
      wert = CDate(Arg)
    Case vbDecimal
      wert = CDec(Arg)
    Case vbString
      wert = CStr(Arg)
    Case vbVariant
      wert = CVar(Arg)
    Case vbUserDefinedType
      wert = CUdf(Arg)       ' interne Umwandlungsfunktion
    Case Else
      wert = Empty
  End Select
 
  If Not IsEmpty(Arg) And IsEmpty(wert) Then
    FehlerNummer = 13
  Else
    Trafo_Wert = True
  End If
  Exit Function
 
fehler:
   FehlerNummer = Err.Number
End Function
Public Property Let wert(ByVal Arg As Variant)
  ' Eigenschaft: Zuweisung von 'Arg' (falls möglich)
 
  Dim iarg As Variant           ' Argument intern
  Dim wert As Variant           ' Wert des Arguments
  Dim FehlerNummer As Long      ' Argument-Check
  Dim i As Long, b As Byte      ' Ascii-Check
 
  On Error GoTo fehler
 
  If gDatenTyp = Empty Then
    ' Keine Deklaration
    Err.Raise 45, App.Title, "Variable nicht deklariert"
    Exit Property
  End If
 
  If IsObject(Arg) Then
    ' Für Zuweisung des Inhalts einer XVAR-Instanz
    iarg = Arg.wert
  Else
    iarg = Arg
  End If
 
  ' aktuellen Wert der Variable löschen
  gWert = vbEmpty
 
  If IsNull(iarg) Or IsError(iarg) Or IsArray(iarg) Then
    ' NULL, ERROR und Arrays sind unzulässig
    Err.Raise 13: Exit Property
  End If
 
  If Not gImplizit Then
    ' die explizite Überprüfung des Datentyps ist gefordert
    If gDatenTyp = vbUserDefinedType Then
      If VarType(iarg) <> vbCurrency Then
        Err.Raise 13: Exit Property
      End If
    ElseIf VarType(iarg) <> gDatenTyp Then
      Err.Raise 13: Exit Property
    End If
  End If
 
  If gNumerisch And Not IsNumeric(iarg) Then
    ' numerisch darstellbarer Wert ist gefordert
    Err.Raise 13: Exit Property
  End If
 
  ' Explizite Datentyp-Umwandlung durch Hilfsfunktion
  If Not Trafo_Wert(iarg, wert, FehlerNummer) Then
    If FehlerNummer = 45 Then
      Err.Raise 45, App.Title, "Variable nicht deklariert"
    Else
      Err.Raise FehlerNummer
    End If
    Exit Property
  End If
 
  ' datentyp-spezifischer Bereichs-Check
  ' des zuzuweisenden Wertes
  If gNumerisch Then
    ' numerische Grenzen überprüfen
    If wert < gUntergrenze Or wert > gObergrenze Then
      Err.Raise 6: Exit Property
    End If
  ElseIf gDatenTyp = vbDate Then
    ' Datum-/Zeitgrenzen überprüfen
    If VBA.DateTime.DateDiff("s", wert, gUntergrenze) > 1 Or _
      VBA.DateTime.DateDiff("s", wert, gObergrenze) < 1 Then
      Err.Raise 6: Exit Property
    End If
  ElseIf gDatenTyp = vbString Then
    ' Stringlänge überprüfen
    If Len(wert) < gUntergrenze Or Len(wert) > gObergrenze Then
      Err.Raise 6: Exit Property
    End If
    ' zulässige Ascii-Codes im String?
    ' Leerzeichen sind immer erlaubt!
    If Not Check_Ascii_Bereich(wert) Then
      Err.Raise 6: Exit Property
    End If
   End If
 
  ' Zuweisung durchführen
  gWert = wert
  Exit Property
 
fehler:
  ' Fehler oder Ereignis im rufenden Programm auslösen
  With Err
    If gFehler_Als_Ereignis Then
      RaiseEvent VariablenFehler(.Number, .Source, .Description)
    ElseIf Not gFehler_Ignorieren Then
      .Raise .Number
    End If
  End With
 
  ' Variablen-Wert zurücksetzen
  gWert = Empty   
End Property
Public Property Get wert() As Variant
  ' Eigenschaft:
  ' Abfrage des aktuellen Wertes der Variable
  On Error GoTo fehler
  If IsEmpty(gDatenTyp) Then
    Err.Raise 45, App.Title, "Variable nicht deklariert"
  ElseIf IsEmpty(gWert) Then
    Err.Raise 46, App.Title, "Variable nicht initialisiert"
  ElseIf IsNull(gWert) Then
    Err.Raise 47, App.Title, "Variable enthält keinen gültigen Wert"
  Else
    ' Abfrage des Wertes
    wert = gWert
  End If
  Exit Property
 
fehler:
  With Err
    If gFehler_Als_Ereignis Then
      RaiseEvent VariablenFehler(.Number, .Source, .Description)
    ElseIf Not gFehler_Ignorieren Then
      .Raise .Number
    End If
  End With   
End Property
Private Function CUdf(ByVal Arg As Variant) As Variant
  ' Hilfsfunktion
  ' Umwandlung von 'Arg' in Ganzzahl-Currency
  ' falls möglich ...
  Const eps As Double = 0.00000000001
 
  If Not IsNumeric(Arg) Then
    Err.Raise 13: Exit Function
  End If
  If Not gImplizit Then
    ' nichtganzzahlige Variable zurückweisen
    If Abs(Int(Arg) - Arg) > (eps * Arg) Then
      Err.Raise 13: Exit Function
    End If
  End If
  CUdf = CCur(Round(Arg, 0))
End Function
Public Function Ascii_Bereich(ByVal ug As Byte, _
  ByVal og As Byte) As Boolean
 
  ' Festlegung des Bereich gültiger Ascii-Werte
  ' bei String-Variablen
 
  gAscii_UG = 0: gAscii_OG = 255
  If gDatenTyp <> vbString Then Exit Function
  If ug <= og Then
    gAscii_UG = ug: gAscii_OG = og
  End If
 
  ' Falls bereits ein String zugewiesen ist,
  ' wird er überprüft
  If Not IsEmpty(gWert) And Not IsNull(gWert) Then
    Ascii_Bereich = Check_Ascii_Bereich(gWert)
  Else
    Ascii_Bereich = True
  End If   
End Function
Private Function Check_Ascii_Bereich(ByVal Arg As String) As Boolean
  ' Überprüfung, ob 'Arg' nur gültige Ascii-Werte enthält
  ' die im Bereich 'gAscii_UG' bis 'gAscii_OG' liegen
  Dim i As Long, b As Byte
 
  Check_Ascii_Bereich = True
  If gDatenTyp = vbString Then
    If gAscii_UG > 0 Or gAscii_OG < 255 Then
      For i = 1 To Len(Arg)
        b = Asc(Mid(Arg, i, 1))
        ' Leerzeichen (= 32) immer erlauben
        If (b < gAscii_UG Or b > gAscii_OG) And b <> 32 Then
          Check_Ascii_Bereich = False: Exit For
        End If
      Next i
    End If
  End If
End Function
Public Property Get Restriktionen( _
  Optional ByRef Untergrenze As Variant, _
  Optional ByRef Obergrenze As Variant, _
  Optional ByRef Implizit As Boolean, _
  Optional ByRef Ascii_UG As Byte, _
  Optional ByRef Ascii_OG As Byte) As VbVarType
 
  ' schreibgeschützte Eigenschaft:
  ' Abfrage der aktuell gesetzten Restriktionen
  Restriktionen = gDatenTyp
  Obergrenze = gObergrenze: Untergrenze = gUntergrenze
  Implizit = gImplizit
  Ascii_UG = gAscii_UG: Ascii_OG = gAscii_OG
End Property
' ============================================================================
' Ende Quellcode Klasse 'clsXVar'
' ============================================================================


' ================================================================
' Start Quellcode Formular 'frmDemo_XVar'
' Beispiele zur Verwendung der Klasse 'clsXVar'
' Die Eigenschaft 'Wert' der Klasse 'clsXVar' muss als 'Voreinstellung' festgelegt sein
' ================================================================
Option Explicit
 
' 2 Zugriffsvariable für clsXVAR-Instanzen deklarieren
Dim WithEvents gX As clsXVar
Dim WithEvents gY As clsXVar
Private Sub Form_Load()
  ' 2 clsXVAR-Instanzen erstellen
  Set gX = New clsXVar
  Set gY = New clsXVar
 
  Show
 
  ' Demo starten
  Demo_XVAR   
End Sub
Private Sub Form_Unload(Cancel As Integer)
  ' Aufräumen
  Set gX = Nothing
  Set gY = Nothing   
End Sub
Private Function Demo_XVAR()
  ' Demonstration der Verwendung von beschränkten Variablen
  ' In der Klasse 'clsXVAR' muss die Eigenschaft 'Wert'
  ' als Voreinstellung festgelegt worden sein!
 
  ' 1. beschränkte DATE-Variable
  ' ============================
  ' DATE-Variable für das Jahr 2005 definieren
  ' Ereignis anfordern, Implizite Zuweisung erlauben, keine Init.
  gX.Dekl vbDate, "1.1.2005 0:00", "31.12.2005 23:59", _
    Implizit:=True, Initialisierung:=False, _
    Fehler_Als_Ereignis:=True
 
  ' Diese Abfrage scheitert, weil 'gX' bei der Deklaration
  ' nicht initialisiert worden ist
  Dim dt As Date
  dt = gX
 
  ' Diese Zuweisung löst das Fehler-Ereignis aus
  ' (Wert ausserhalb der gültigen Grenzen: Überlauf)
  gX = "1.1.2006"
 
  ' Diese Zuweisung wird ausgeführt (String --> Date)
  gX = "10.12.2005 17:25"
 
  ' Kontrolle der Zuweisung
  If gX <> CDate("10.12.2005 17:25") Then
    MsgBox "Falsche Zuweisung auf gX", vbExclamation
  End If
 
  ' DATE-Variable für das Jahr 2005 definieren
  ' Ereignis anfordern, Implizite Zuweisung verbieten (=Standard)
  gX.Dekl vbDate, "1.1.2005 0:00", "31.12.2005 23:59", _
    Fehler_Als_Ereignis:=True
 
  ' Diese Zuweisung wird jetzt nicht mehr ausgeführt
  ' (String --> Date: Typen unverträglich)
  gX = "10.12.2005 17:25"
 
  ' Diese Zuweisung wird ausgeführt (Date --> Date)
  gX = CDate("10.12.2005 17:25")
 
  ' 2. Date-Variable für 2005 deklarieren
  gY.Dekl vbDate, "1.1.2005 0:00", "31.12.2005 23:59", _
    Implizit:=True, Initialisierung:=False, _
    Fehler_Als_Ereignis:=True
 
  ' Anwendung der DATE-Funktionen
  ' 5 Tage zu gX addieren
  gY = DateAdd("d", 5, gX)
  ' Differenz überprüfen
  MsgBox CStr(gX) + vbCrLf + CStr(gY) + vbCrLf + vbCrLf + _
    "Differenz gY, gX: " + CStr(DateDiff("d", gX, gY)) + " Tage"
 
  MsgBox CStr(gX) + vbCrLf + vbCrLf + _
    "TimeValue: " + CStr(TimeValue(gX))
 
 
  ' 2. Objekt-Verweise bei beschränkten Variablen
  ' =============================================
 
  ' Wert-Zuweisung durch Verweis ist möglich,
  ' aber nicht empfehlenswert:
  ' beide Variable werden dadurch intern identisch
  Set gY = gX
  MsgBox "Verweis auf gY gesetzt: " + CStr(gY)
 
  gX = CDate("19.5.2005")
  MsgBox "Verweis auf gY gesetzt: " + CStr(gY)
 
  gY = CDate("25.8.2005")
  MsgBox "gX: " + CStr(gX)
 
  ' Verweis lösen, gY neu einrichten
  Set gY = New clsXVar
 
 
  ' 3. beschränkte String-Variable
  ' ==============================
 
  ' 2 String-Variablen für Länge 20 bis 40 deklarieren
  gX.Dekl vbString, 20, 40, , , True
  gY.Dekl vbString, 20, 40, , , True
 
  ' Diese Zuweisung scheitert, weil die implizite Typ-Umwandlung
  ' verboten ist (Typen unverträglich)
  gX = 100
 
  ' Diese Zuweisung scheitert, weil der String kürzer als
  ' 20 Zeichen ist (Überlauf)
  gX = "Hallo XVAR!"
 
  ' Diese Zuweisung klappt
  gX = "Hallo XVAR! Klappt's jetzt endlich?"
 
  ' Kontrolle der Zuweisung
  If gX <> "Hallo XVAR! Klappt's jetzt endlich?" Then
    MsgBox "Falsche Zuweisung auf gX", vbExclamation
  End If
 
  ' String-Variable ohne Beschränkung deklarieren
  gX.Dekl vbString, Implizit:=True, _
    Fehler_Als_Ereignis:=True
 
  ' Diese Zuweisungen funktionieren
  gX = 1234567: gY = "12.4.2000 09:25:00 PM"
  ' Die Zuweisung gY = CDate("12.4.2000 09:25:00 PM")
  ' würde nicht funktionieren, weil in der 24-Stunden-Anzeige
  ' Datum-/Uhrzeit = '12.04.2000 21:25:00' kürzer als 20 Zeichen ist
 
  ' String-Operationen sind zulässig ....
  Dim str As String
  str = gX + " | " + gX + " | " + gY
 
  MsgBox "String-Addition: " + str
 
  ' ... aber nur im Rahmen der gesetzten Beschränkung
  ' (max. 40 Zeichen --> Überlauf)
 
  gY = gX + " | " + gX + " | was auch immer noch kommt ... "
 
  ' 200 Zeichen zulassen
  gY.Dekl vbString, 0, 200, Fehler_Als_Ereignis:=True
 
  ' jetzt klappt es
  gY = gX + " | " + gX + " | was auch immer noch kommt ... "
 
  MsgBox "gY= " + gY
 
  ' Verwendung von String-Funktionen
  ' bei INSTR immer das 1. Argument (Start) angeben!!
  MsgBox "Position von '" + gX + "' in '" + gY + "': " + _
  CStr(InStr(1, gY, gX, vbTextCompare))
  MsgBox "Position von 'was' in '" + gY + "': " + _
  CStr(InStr(1, gY, "was", vbTextCompare))
 
  MsgBox gX + vbCrLf + Mid(gY, 1, 7) + vbCrLf + vbCrLf + _
    "Strcomp = " + CStr(StrComp(gX, Mid(gY, 1, 7), vbTextCompare))
 
  ' In 'gX' nur noch Kleinschreibung zulassen
  ' Sonderzeichen oder Ziffern im String ---> Überlauf
  gX.Ascii_Bereich Asc("a"), Asc("z")
 
  ' Da der String in gX '1234567' der neu gesetzten Beschränkung
  ' nicht mehr entsprochen hat, ist er gelöscht worden (NULL)
  ' Abfrage scheitert --> Typen unverträglich
   gY = gX
 
  ' wegen des als unzulässig eingestuften Fragezeichens
  ' klappt diese Zuweisung nicht ... ---> Überlauf
  gX = "aber das geht noch??"
 
  ' ... aber diese Zuweisung klappt
  ' (Leerzeichen sind immer erlaubt
  gX = "aber das geht noch  "
 
  ' Kontrolle
  If gX <> "aber das geht noch  " Then
    MsgBox "Falsche Zuweisung auf gX", vbExclamation
  End If
 
 
  ' 4. beschränkter Ganzzahl-Datentyp
  ' =================================
 
  ' Ganzzahl-Variable definieren
  ' Ereignis anfordern, Implizite Zuweisung verbieten (=Standard)
  gX.Dekl vbUserDefinedType, 2 * 10 ^ 8, 2 * 10 ^ 12, Fehler_Als_Ereignis:=True
 
  ' Diese Zuweisung wird nicht durchgeführt
  ' der Currency-Typ ist zwar korrekt, aber es ist keine Ganzzahl
  gX = CCur(200000000.5)
 
  ' Diese Zuweisung wird durchgeführt
  ' Ganzzahl im Gültigkeitsbereich
  gX = CCur(200000000)
 
  ' zweite Ganzzahl-Variable definieren
  ' implizite Zuweisung verbieten
  gY.Dekl vbUserDefinedType, 2 * 10 ^ 8, 2 * 10 ^ 12, _
           Fehler_Als_Ereignis:=True
 
  ' Diese Zuweisung wird ausgeführt
  ' Das Ergebnis liegt im gültigen Bereich
  gY = gX * 4
 
  ' Diese Zuweisung wird nicht ausgeführt
  ' Das Ergebnis ist nicht ganzzahlig: Typen unverträglich
  gY = CCur(gX * 4.134256723)
 
  ' Diese Zuweisung wird nicht ausgeführt
  ' Der Wert ist zwar ganzzahlig gerundet,
  ' aber nicht vom Typ Currency
  gY = Round(gX * 4.134256723, 0)
 
  ' Jetzt erst klappt's
  gY = CCur(Round(gX * 4.134256723, 0))
 
  MsgBox "gY = " + CStr(gY)
 
 
  ' 5. Beschränkte Double-Variable
  ' ==============================
 
  ' Geltungsbereich -50 bis 50
  ' implizite Zuweisung wird erlaubt
  gX.Dekl vbDouble, -50, 50, Implizit:=True, Fehler_Als_Ereignis:=True
 
  ' Zuweisung des numerisch interpret. String funktioniert
  gX = "000"
 
  ' Zuweisung funktioniert nicht (Überlauf)
  gX = -100
 
  ' Diese Zuweisung funktioniert, weil zuerst der Ausdruck
  ' ausgewertet wird (als Long), ehe es zur Zuweisung kommt
  gX = 25 + 100000 - 99975
 
  ' Kontrolle
  If Abs(gX - 50) > 0.000000001 Then
    MsgBox "Falsche Zuweisung auf gX", vbExclamation
  End If
 
  ' gY kann nur den Wert 125000 annehmen
  gY.Dekl vbDouble, 125000, 125000, Implizit:=True, Fehler_Als_Ereignis:=True
 
  ' Einige Rechenoperationen
  gY = gX ^ 3: gX = 0
  gX = Exp(Log(gY) / 3)
 
  If Abs(gX - 50) > 0.00000001 Then
    MsgBox "Fehler bei Berechnung", vbExclamation
  End If
 
 
  ' 6. Arrays aus beschränkten Variablen
  ' ====================================
 
  ' Deklaration einer Array-Variable, für ein Array,
  ' dessen Elemente aus 'clsXVar'-Instanzen bestehen
  Dim Arr() As clsXVar
  ' Dynamische Deklaration des Array
  ReDim Arr(-10 To 10, -5 To 5)
 
  Dim i As Long, k As Long                 ' Loop
 
  ' Erstellung der Objekt-Instanzen und Deklaration
  ' der einzelnen 'beschränkten Variablen' im Array
  ' (Integer, gültig -100 bis 100, keine impliz. Zuweisung)
  For i = LBound(Arr, 1) To UBound(Arr, 1)
    For k = LBound(Arr, 2) To UBound(Arr, 2)
      Set Arr(i, k) = New clsXVar
      ' Falls 'Fehler_Als_Ereignis' müssen die Ereignisse
      ' über eine WithEvents-Instanz aufgefangen werden
      Arr(i, k).Dekl vbInteger, -100, 100, Fehler_Als_Ereignis:=True
    Next k
  Next i
 
  ' Fehler-Ereignis (bei unzulässiger Zuweisung zu
  ' einem Array-Element) durch Verweis auf
  ' eine 'WithEvents'-Objektvariable ermöglichen
  Set gX = Arr(-10, 5)  'für Fehler-Ereignis im Array-Element
  ' Diese Zuweisung scheitert (unzulässiger Wert)
  ' ---> das 'gX'-Ereignis tritt auf (Überlauf)
  Arr(-10, 5) = -200
 
  ' Diese Zuweisungen sind zulässig:
  ' Der Variablentyp von Zahlen unter +/-32767
  ' ist automatisch 'Integer'
  Arr(-10, -5) = -100
  Set gX = Arr(10, 5)
  Arr(10, 5) = 100
 
  ' Das Ergebnis dieser Operationen bleibt 'Integer'
  Set gX = Arr(0, 0)
  Arr(0, 0) = (Arr(-10, -5) + 10 + Arr(10, 5)) \ 2
 
  ' Das Ergebnis dieser Operationen muss explizit
  ' von 'Double' auf 'Integer' umgewandelt werden
  ' (Informations-Verlust!)
  Set gX = Arr(1, 1)
  Arr(1, 1) = CInt(Arr(0, 0) / 3)
  Set gX = Arr(2, 2)
  Arr(2, 2) = CInt(Sqr((Arr(0, 0) + Arr(1, 1)) * 100))         
End Function
Private Sub gX_VariablenFehler(Fehler_Nummer As Long, _
  Quelle As String, Beschreibung As String)
 
  ' Fehler-Ereignis der Variable gX
  Dim Meldung As String
 
  Meldung = "Fehler: " + CStr(Fehler_Nummer) + vbCrLf + _
    "Quelle: " + CStr(Quelle) + vbCrLf + _
    "Beschreibung: " + CStr(Beschreibung)
 
  Variablen_EreignisMeldung gX, "gX", Meldung       
End Sub
Private Sub gY_VariablenFehler(Fehler_Nummer As Long, _
  Quelle As String, Beschreibung As String)
 
  ' Fehler-Ereignis der Variable gY
  Dim Meldung As String
 
  Meldung = "Fehler: " + CStr(Fehler_Nummer) + vbCrLf + _
    "Quelle: " + CStr(Quelle) + vbCrLf + _
    "Beschreibung: " + CStr(Beschreibung)
 
  Variablen_EreignisMeldung gY, "gY", Meldung     
End Sub
Private Sub Variablen_EreignisMeldung(var As clsXVar, _
  ByVal Name As String, _
  ByVal Meldung As String)
 
  ' Anzeige einer 'clsXVar'-Ereignismeldung,
  ' einschließlich der aktuell gesetzten
  ' Variablen-Restriktionen
 
  Dim dt As VbVarType, impl As Boolean, ug, og
 
  If var Is Nothing Then Exit Sub
  ' aktuelle Variablen-Restriktionen abfragen
  dt = var.Restriktionen(ug, og, impl)
 
  ' Variable, Restriktionen und Meldung anzeigen
  MsgBox "Variable: " + Name + vbCrLf + vbCrLf + _
    "Datentyp: " + CDT(dt) + vbCrLf + _
    "Grenzen: " + CStr(ug) + " --- " + CStr(og) + vbCrLf + _
    "Implizite Zuweisung: " + CStr(impl) + vbCrLf + _
    vbCrLf + Meldung, vbInformation        
End Sub
Private Function CDT(ByVal vt As VbVarType) As String
  ' Hilfsfunktion für Variablen_EreignisMeldung
  Select Case vt
    Case vbByte
      CDT = "Byte"
    Case vbCurrency
      CDT = "Currency"
    Case vbDate
      CDT = "Date"
    Case vbDecimal
      CDT = "Decimal"
    Case vbDouble
      CDT = "Double"
    Case vbInteger
      CDT = "Integer"
    Case vbLong
      CDT = "Long"
    Case vbSingle
      CDT = "Single"
    Case vbString
      CDT = "String"
    Case vbUserDefinedType
      CDT = "Ganzzahl"
  End Select   
End Function
' =============================================================
' Ende Quellcode Formular 'frmDemo_XVAR'
' =============================================================

Dieser Tipp wurde bereits 20.481 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 vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

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.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv 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