vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Variablen/Strings · UDT (Benutzerdefinierte Datentypen)   |   VB-Versionen: VB5, VB611.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 GrimmBewertung:     [ Jetzt bewerten ]Views:  8.796 
ohne HomepageSystem:  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

Dieser Tipp wurde bereits 8.796 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