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 Dieser Tipp wurde bereits 8.591 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 (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. |
Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |