Rubrik: Variablen/Strings · UDT (Benutzerdefinierte Datentypen) | VB-Versionen: VB5, VB6 | 11.03.08 |
Füllen eines UDT's Füllen eines UDT's (user defined type) mit für den Datentyp gültigen Werten | ||
Autor: Norbert Grimm | Bewertung: | Views: 8.590 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Die Funktion CVTyp wandelt einen beliebigen an sie übergebenen Wert in einen für den Datentyp gültigen Wert (Rückgabewert).
' Test-UDT Private Type vb_Variable nBool As Boolean nInteger As Integer nLong As Long nSingle As Single nDouble As Double dDate As Date sString As String * 25 End Type
' TestAufruf ' Füllen eines UDT's (user defined type) mit ' für den Datentyp gültigen Werten Private Function ConvVariable() As Integer Dim CV As Long Dim udtWert As vb_Variable Dim vArray() As Variant Dim V As Variant On Error GoTo Err_CV ' TestArray vArray = Array(True, 999, 99999999, 99.9, "25.02.2008", "vb@rchiv", "") With udtWert CV = CVTyp(.nBool, vArray(0)) CV = CVTyp(.nInteger, vArray(1)) CV = CVTyp(.nLong, vArray(2)) CV = CVTyp(.nSingle, vArray(3)) CV = CVTyp(.nDouble, vArray(4)) ' XIn: ein DatumsType CV = CVTyp(.dDate, vArray(4)) CV = CVTyp(.sString, vArray(5)) End With MsgBox vArray(4) & vbCr & udtWert.nDouble & _ vbCr & vbCr & vArray(5) & vbCr & udtWert.sString, _ vbInformation, "TestAufruf" & Space(50) With udtWert CV = CVTyp(.nBool, vArray(6)) ' XIn: "" End With MsgBox vArray(6) & vbCr & udtWert.nBool, _ vbInformation, "TestAufruf" & Space(50) With udtWert CV = CVTyp(.sString, V) ' XIn: leer oder NULL End With MsgBox "[leer oder NULL]" & vbCr & udtWert.sString, _ vbInformation, "TestAufruf" & Space(50) Exit_CV: Exit Function Err_CV: MsgBox Err & vbCr & Err.Description, vbInformation, "ConvVariable" Resume Exit_CV End Function
' Datentypische Umwandlung eines beliebigen Wertes Function CVTyp(XOut As Variant, XIn As Variant) As Long Dim XVal As Variant Dim XTyp As Integer On Error GoTo Err_CVTyp ' check den VariablenTyp des Rückgabewertes (XOut) XTyp = VarType(XOut) ' Selektion an Hand des DatenTyps ' und datentypische Umwandlung des Einganswertes (XIn) Select Case XTyp Case vbBoolean If XIn > "" Then XVal = CBool(XIn) Else XVal = False End If Case vbInteger XVal = CInt(Val(XIn)) Case vbLong XVal = CLng(Val(XIn)) Case vbDate If Not IsDate(XIn) Then XIn = Now XVal = CDate(XIn) Case vbSingle If Not IsNumeric(XIn) Then XIn = 0 XVal = CSng(XIn) Case vbDouble If Not IsNumeric(XIn) Then XIn = 0 XVal = CDbl(XIn) Case vbString If IsNull(XIn) Then XIn = "" XVal = CStr(XIn) Case vbUserDefinedType Case Else XVal = "" End Select XOut = XVal CVTyp = XTyp Exit_CVTyp: Exit Function Err_CVTyp: XOut = 0 MsgBox Err & vbCr & Err.Description, vbCritical, "CVTyp" Resume Exit_CVTyp End Function