vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
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:  Views:  8.590 
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



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.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle 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.