+ First working variant support

rtl/inc/variant.inc

@@ -63,48 +63,55 @@ procedure variant_clear(var v : variant);[Public,Alias:'FPC_VARIANT_CLEAR'];
 operator :=(const source : byte) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,1);
 end;
 
 
 operator :=(const source : shortint) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,-1);
 end;
 
 
 operator :=(const source : word) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,2);
 end;
 
 
 operator :=(const source : smallint) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,-2);
 end;
 
 
 operator :=(const source : dword) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,4);
 end;
 
 
 operator :=(const source : longint) dest : variant;
 
 begin
-  Variantmanager.varfromInt(Dest,Source);
+//  Variant_Init(Dest);
+  Variantmanager.varfromInt(Dest,Source,-4);
 end;
 
 
 operator :=(const source : qword) dest : variant;
 
 begin
+  Variant_Init(Dest);
   Variantmanager.varfromWord64(Dest,Source);
 end;
 
@@ -112,6 +119,7 @@ end;
 operator :=(const source : int64) dest : variant;
 
 begin
+  Variant_Init(Dest);
   Variantmanager.varfromInt64(Dest,Source);
 end;
 
@@ -120,6 +128,7 @@ end;
 operator :=(const source : boolean) dest : variant;
 
 begin
+  Variant_Init(Dest);
   Variantmanager.varfromBool(Dest,Source);
 end;
 
@@ -127,6 +136,7 @@ end;
 operator :=(const source : wordbool) dest : variant;
 
 begin
+  Variant_Init(Dest);
   Variantmanager.varfromBool(Dest,Boolean(Source));
 end;
 
@@ -134,6 +144,7 @@ end;
 operator :=(const source : longbool) dest : variant;
 
 begin
+  Variant_Init(Dest);
   Variantmanager.varfromBool(Dest,Boolean(Source));
 end;
 
@@ -143,6 +154,7 @@ end;
 operator :=(const source : char) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromPStr(Dest,Source);
 end;
 
@@ -150,6 +162,7 @@ end;
 operator :=(const source : widechar) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromWStr(Dest,Source);
 end;
 
@@ -158,6 +171,7 @@ end;
 operator :=(const source : shortstring) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromPStr(Dest,Source);
 end;
 
@@ -165,6 +179,7 @@ end;
 operator :=(const source : ansistring) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromLStr(Dest,Source);
 end;
 
@@ -172,6 +187,7 @@ end;
 operator :=(const source : widestring) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromWStr(Dest,Source);
 end;
 
@@ -180,6 +196,7 @@ end;
 operator :=(const source : single) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromReal(Dest,Source);
 end;
 
@@ -187,6 +204,7 @@ end;
 operator :=(const source : double) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromReal(Dest,Source);
 end;
 
@@ -194,12 +212,14 @@ end;
 operator :=(const source : extended) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromReal(Dest,Source);
 end;
 
 Operator :=(const source : comp) dest : variant;
 
 begin
+  Variant_Init(Dest);
   VariantManager.VarFromReal(Dest,Source);
 end;
 
@@ -437,7 +457,10 @@ procedure initvariantmanager;
 
 {
   $Log$
-  Revision 1.3  2001-11-08 20:59:10  michael
+  Revision 1.4  2001-11-14 23:00:16  michael
+  + First working variant support
+
+  Revision 1.3  2001/11/08 20:59:10  michael
   + System unit implementation of variants
 
   Revision 1.2  2001/11/08 16:17:30  florian

rtl/inc/varianth.inc

@@ -110,7 +110,8 @@ type
          1:(vwords : array[0..6] of word);
          2:(vbytes : array[0..13] of byte);
       end;
-
+   pvardata = ^tvardata;
+   
    pcalldesc = ^tcalldesc;
    tcalldesc = packed record
       calltype,argcount,namedargcount : byte;
@@ -141,7 +142,7 @@ type
          typeinfo : pointer);
 
       varfrombool : procedure(var dest : variant;const source : Boolean);
-      varfromint : procedure(var dest : variant;const source : longint);
+      varfromint : procedure(var dest : variant;const source,Range : longint);
       varfromint64 : procedure(var dest : variant;const source : int64);
       varfromword64 : procedure(var dest : variant;const source : qword);
       varfromreal : procedure(var dest : variant;const source : extended);
@@ -255,7 +256,10 @@ operator :=(const source : variant) dest : tdatetime;
 }
 {
   $Log$
-  Revision 1.3  2001-11-08 20:59:10  michael
+  Revision 1.4  2001-11-14 23:00:17  michael
+  + First working variant support
+
+  Revision 1.3  2001/11/08 20:59:10  michael
   + System unit implementation of variants
 
   Revision 1.2  2001/11/08 16:17:30  florian

rtl/objpas/cvarutil.inc

@@ -63,6 +63,7 @@ begin
   With VargSrc do
     Case (VType and VarTypeMask) of
       VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
       VarInteger : Result:=VInteger;
       VarSingle  : Result:=Round(VSingle);
       VarDouble  : Result:=Round(VDouble);
@@ -71,6 +72,34 @@ begin
       VarOleStr  : NoWideStrings;
       VarBoolean : Result:=SmallInt(VBoolean);
       VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToShortInt(Const VargSrc : TVarData) : ShortInt;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=Round(VSingle);
+      VarDouble  : Result:=Round(VDouble);
+      VarCurrency: Result:=Round(VCurrency);
+      VarDate    : Result:=Round(VDate);
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=SmallInt(VBoolean);
+      VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
   else
     VariantTypeMismatch;
   end;
@@ -82,6 +111,31 @@ begin
   With VargSrc do
     Case (VType and VarTypeMask) of
       VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
+      VarInteger : Result:=VInteger;
+      VarSingle  : Result:=Round(VSingle);
+      VarDouble  : Result:=Round(VDouble);
+      VarCurrency: Result:=Round(VCurrency);
+      VarDate    : Result:=Round(VDate);
+      VarOleStr  : NoWideStrings;
+      VarBoolean : Result:=Longint(VBoolean);
+      VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
+  else
+    VariantTypeMismatch;
+  end;
+end;
+
+Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
+
+begin
+  With VargSrc do
+    Case (VType and VarTypeMask) of
+      VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
       VarInteger : Result:=VInteger;
       VarSingle  : Result:=Round(VSingle);
       VarDouble  : Result:=Round(VDouble);
@@ -90,6 +144,10 @@ begin
       VarOleStr  : NoWideStrings;
       VarBoolean : Result:=Longint(VBoolean);
       VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
   else
     VariantTypeMismatch;
   end;
@@ -101,6 +159,7 @@ begin
   With VargSrc do
     Case (VType and VarTypeMask) of
       VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
       VarInteger : Result:=VInteger;
       VarSingle  : Result:=VSingle;
       VarDouble  : Result:=VDouble;
@@ -109,6 +168,10 @@ begin
       VarOleStr  : NoWideStrings;
       VarBoolean : Result:=Longint(VBoolean);
       VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
   else
     VariantTypeMismatch;
   end;
@@ -120,6 +183,7 @@ begin
   With VargSrc do
     Case (VType and VarTypeMask)  of
       VarSmallInt: Result:=VSmallInt;
+      VarShortInt: Result:=VShortInt;
       VarInteger : Result:=VInteger;
       VarSingle  : Result:=VSingle;
       VarDouble  : Result:=VDouble;
@@ -128,6 +192,10 @@ begin
       VarOleStr  : NoWideStrings;
       VarBoolean : Result:=Longint(VBoolean);
       VarByte    : Result:=VByte;
+      VarWord    : Result:=VWord;
+      VarLongWord   : Result:=VLongWord;
+      VarInt64   : Result:=VInt64;
+      VarQword   : Result:=VQWord;
   else
     VariantTypeMismatch;
   end;
@@ -140,6 +208,7 @@ begin
     With VargSrc do
       Case (VType and VarTypeMask) of
         VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
         VarInteger : Result:=VInteger;
         VarSingle  : Result:=FloatToCurr(VSingle);
         VarDouble  : Result:=FloatToCurr(VDouble);
@@ -148,6 +217,10 @@ begin
         VarOleStr  : NoWideStrings;
         VarBoolean : Result:=Longint(VBoolean);
         VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
     else
       VariantTypeMismatch;
     end;
@@ -159,6 +232,7 @@ begin
   end;
 end;
 
+
 Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
 
 begin
@@ -166,6 +240,7 @@ begin
     With VargSrc do
       Case (VType and VarTypeMask) of
         VarSmallInt: Result:=FloatToDateTime(VSmallInt);
+        VarShortInt: Result:=FloatToDateTime(VShortInt);
         VarInteger : Result:=FloatToDateTime(VInteger);
         VarSingle  : Result:=FloatToDateTime(VSingle);
         VarDouble  : Result:=FloatToDateTime(VDouble);
@@ -174,6 +249,10 @@ begin
         VarOleStr  : NoWideStrings;
         VarBoolean : Result:=FloatToDateTime(Longint(VBoolean));
         VarByte    : Result:=FloatToDateTime(VByte);
+        VarWord    : Result:=FloatToDateTime(VWord);
+        VarLongWord    : Result:=FloatToDateTime(VLongWord);
+        VarInt64   : Result:=FloatToDateTime(VInt64);
+        VarQWord   : Result:=FloatToDateTime(VQword);
     else
       VariantTypeMismatch;
     end;
@@ -191,6 +270,7 @@ begin
   With VargSrc do
     Case (VType and VarTypeMask) of
       VarSmallInt: Result:=VSmallInt<>0;
+      VarShortInt: Result:=VShortInt<>0;
       VarInteger : Result:=VInteger<>0;
       VarSingle  : Result:=VSingle<>0;
       VarDouble  : Result:=VDouble<>0;
@@ -199,6 +279,10 @@ begin
       VarOleStr  : NoWideStrings;
       VarBoolean : Result:=VBoolean;
       VarByte    : Result:=VByte<>0;
+      VarWord    : Result:=VWord<>0;
+      VarLongWord   : Result:=VLongWord<>0;
+      VarInt64   : Result:=Vint64<>0;
+      VarQword   : Result:=VQWord<>0;
   else
     VariantTypeMismatch;
   end;
@@ -211,6 +295,7 @@ begin
     With VargSrc do
       Case (VType and VarTypeMask) of
         VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
         VarInteger : Result:=VInteger;
         VarSingle  : Result:=Round(VSingle);
         VarDouble  : Result:=Round(VDouble);
@@ -219,6 +304,72 @@ begin
         VarOleStr  : NoWideStrings;
         VarBoolean : Result:=Longint(VBoolean);
         VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=Vint64;
+        VarQword   : Result:=VQWord;
+    else
+      VariantTypeMismatch;
+    end;
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
+end;
+
+Function VariantToInt64(Const VargSrc : TVarData) : Int64;
+
+begin
+  Try
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=FloatToCurr(VSingle);
+        VarDouble  : Result:=FloatToCurr(VDouble);
+        VarCurrency: Result:=VCurrency;
+        VarDate    : Result:=FloatToCurr(VDate);
+        VarOleStr  : NoWideStrings;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
+    else
+      VariantTypeMismatch;
+    end;
+  except
+    On EConvertError do
+      VariantTypeMismatch;
+    else
+      Raise;
+  end;
+end;
+
+Function VariantToQWord(Const VargSrc : TVarData) : QWord;
+
+begin
+  Try
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallint;
+        VarShortInt: Result:=VShortInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=FloatToCurr(VSingle);
+        VarDouble  : Result:=FloatToCurr(VDouble);
+        VarCurrency: Result:=VCurrency;
+        VarDate    : Result:=FloatToCurr(VDate);
+        VarOleStr  : NoWideStrings;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
     else
       VariantTypeMismatch;
     end;
@@ -233,7 +384,10 @@ end;
 {$endif HASVARIANT}
 {
   $Log$
-  Revision 1.2  2001-08-19 21:02:02  florian
+  Revision 1.3  2001-11-14 23:00:17  michael
+  + First working variant support
+
+  Revision 1.2  2001/08/19 21:02:02  florian
     * fixed and added a lot of stuff to get the Jedi DX( headers
       compiled
 

rtl/objpas/datih.inc

@@ -69,8 +69,6 @@ type
       Hour, Minute, Second, MilliSecond: word;
    end ;
 
-   TDateTime = double;
-
    TTimeStamp = record
       Time: integer;   { Number of milliseconds since midnight }
       Date: integer;   { One plus number of days since 1/1/0001 }
@@ -108,7 +106,10 @@ Procedure GetLocalTime(var SystemTime: TSystemTime);
 
 {
   $Log$
-  Revision 1.3  2000-08-20 15:46:46  peter
+  Revision 1.4  2001-11-14 23:00:17  michael
+  + First working variant support
+
+  Revision 1.3  2000/08/20 15:46:46  peter
     * sysutils.pp moved to target and merged with disk.inc, filutil.inc
 
 }

rtl/objpas/varutilh.inc

@@ -13,11 +13,19 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+
  **********************************************************************}
-{$ifdef HASVARIANT}
+
 
 Type
 
+  EVarianterror = Class(Exception)
+    ErrCode : longint;
+    Constructor CreateCode(Code : Longint);
+  end;
+
+{$ifndef HASVARIANT}
+
   // Types needed to make this work. These should be moved to the system unit.
 
   currency            = int64;
@@ -35,10 +43,6 @@ Type
   PWordBool           = ^WordBool;
   PByte               = ^Byte;
 
-  EVarianterror = Class(Exception)
-    ErrCode : longint;
-    Constructor CreateCode(Code : Longint);
-  end;
 
   TVarArrayBound = packed record
     ElementCount: Longint;
@@ -92,7 +96,9 @@ Type
   end;
   Variant = TVarData;
   PVariant = ^Variant;
+{$endif}
 
+{$ifdef hasvariant}
 { Variant functions }
 
 function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
@@ -128,12 +134,20 @@ function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
 
 Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
 Function VariantToLongint(Const VargSrc : TVarData) : Longint;
+Function VariantToShortint(Const VargSrc : TVarData) : ShortInt;
+Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
 Function VariantToSingle(Const VargSrc : TVarData) : Single;
 Function VariantToDouble(Const VargSrc : TVarData) : Double;
 Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
 Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
 Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
 Function VariantToByte(Const VargSrc : TVarData) : Byte;
+Function VariantToInt64(Const VargSrc : TVarData ) : Int64;
+Function VariantToQWord(Const VargSrc : TVarData ) : Qword;
+
+{Debug routines }
+Procedure DumpVariant(Const VArgSrc : TVarData);
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
 
 
 // Names match the ones in Borland varutils unit.
@@ -162,7 +176,10 @@ const
 
 {
   $Log$
-  Revision 1.2  2001-08-19 21:02:02  florian
+  Revision 1.3  2001-11-14 23:00:17  michael
+  + First working variant support
+
+  Revision 1.2  2001/08/19 21:02:02  florian
     * fixed and added a lot of stuff to get the Jedi DX( headers
       compiled
 

rtl/objpas/varutils.inc

@@ -47,14 +47,17 @@ end;
 function VariantClear(var Varg: TVarData): HRESULT;stdcall;
 begin
   With Varg do
-    if (VType and varArray) <> 0 then
+    if (VType and varArray)=varArray then
+      begin
       Exit(SafeArrayDestroy(VArray))
+      end
     else
       begin
       if (VType and varByRef) = 0 then
         case VType of
           varEmpty, varNull, varSmallint, varInteger, varSingle, varDouble,
-          varCurrency, varDate, varError, varBoolean, varByte:;
+          varCurrency, varDate, varError, varBoolean, varByte,VarShortInt,
+          varInt64, VarLongWord,VarQWord:;
           varOleStr:
             NoWideStrings;
           varDispatch,
@@ -86,7 +89,8 @@ begin
         case (VType and varTypeMask) of
           varEmpty, varNull:;
           varSmallint, varInteger, varSingle, varDouble, varCurrency,
-          varDate, varError, varBoolean, varByte:
+          varDate, varError, varBoolean, varByte,VarShortInt,
+          varInt64, VarLongWord,VarQWord:
             Move(VBytes, VargDest.VBytes, SizeOf(VargDest.VBytes));
           varOleStr:
             NoWideStrings; // We should copy here...
@@ -121,8 +125,11 @@ begin
       varBoolean  : VargDest.VBoolean:=PWordBool(VPointer)^;
       varError    : VargDest.VError:=PError(VPointer)^;
       varByte     : VargDest.VByte:=PByte(VPointer)^;
-      varVariant  : // Variant(VargDest):=PVariant(VPointer)^
-        ;
+      VarShortInt : VargDest.VShortInt:=PShortInt(VPointer)^;
+      VarInt64    : VargDest.VInt64:=PInt64(VPointer)^;
+      VarLongWord : VargDest.VLongWord:=PCardinal(VPointer)^;
+      VarQWord    : VargDest.VQWord:=PQWord(VPointer)^;
+      varVariant  : Variant(VargDest):=Variant(PVarData(VPointer)^);
       varOleStr   : NoWideStrings;
       varDispatch,
       varUnknown  : NoInterfaces;
@@ -165,6 +172,10 @@ begin
           varUnknown  : Result:=VAR_TYPEMISMATCH;
           varBoolean  : VargDest.VBoolean:=VariantToBoolean(Tmp);
           varByte     : VargDest.VByte:=VariantToByte(Tmp);
+          VarShortInt : VargDest.VShortInt:=VariantToShortInt(Tmp);
+          VarInt64    : VargDest.Vint64:=VariantToInt64(Tmp);
+          VarLongWord : VargDest.VLongWord:=VariantToCardinal(Tmp);
+          VarQWord    : VargDest.VQWord:=VariantToQword(tmp);
        else
           Result:=VAR_BADVARTYPE;
        end;
@@ -686,10 +697,125 @@ begin
     Result:=psa^.ElementSize;
 end;
 
+{ ---------------------------------------------------------------------
+    Some debug routines
+  ---------------------------------------------------------------------}
+  
+
+Procedure DumpVariant(Const VArgSrc : TVarData);
+
+begin
+  DumpVariant(Output,VArgSrc);
+end;
+
+(*
+   tvardata = packed record
+      vtype : tvartype;
+      case integer of
+         0:(res1 : word;
+            case integer of
+               0:
+                 (res2,res3 : word;
+                  case word of
+                     varsmallint : (vsmallint : smallint);
+                     varinteger : (vinteger : longint);
+                     varsingle : (vsingle : single);
+                     vardouble : (vdouble : double);
+                     varcurrency : (vcurrency : currency);
+                     vardate : (vdate : tdatetime);
+                     varolestr : (volestr : pwidechar);
+                     vardispatch : (vdispatch : pointer);
+                     varerror : (verror : dword);
+                     varboolean : (vboolean : wordbool);
+                     varunknown : (vunknown : pointer);
+                     // vardecimal : ( : );
+                     varshortint : (vshortint : shortint);
+                     varbyte : (vbyte : byte);
+                     varword : (vword : word);
+                     varlongword : (vlongword : dword);
+                     varint64 : (vint64 : int64);
+                     varqword : (vqword : qword);
+                     varword64 : (vword64 : qword);
+                     varstring : (vstring : pointer);
+                     varany :  (vany : pointer);
+                     vararray : (varray : pvararray);
+                     varbyref : (vpointer : pointer);
+                 );
+               1:
+                 (vlongs : array[0..2] of longint);
+           );
+         1:(vwords : array[0..6] of word);
+         2:(vbytes : array[0..13] of byte);
+      end;
+
+*)
+
+Const 
+
+  VarTypeStrings : Array [varEmpty..varqword] of string = (
+  'empty',  'null',  'smallint',  'integer',  'single',  'double',
+  'currency',  'date',  'olestr',  'dispatch',  'error',  'boolean',
+  'variant',  'unknown',  'unknown','decimal',  'shortint',  'byte',  'word',
+  'longword',  'int64',  'qword');
+
+
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+
+begin
+  If VArgSrc.vType in [varEmpty..varqword] then
+    Writeln(F,'Variant has type : ',VarTypeStrings[VArgSrc.vType])
+  else if (VArgSrc.vType=VarArray) Then
+    begin
+    Write(F,'Variant is array.');
+    exit;
+    end
+  else if (VargSrc.vType=VarByRef) then
+    begin
+    Writeln(F,'Variant is by reference.');
+    exit;
+    end
+  else
+    begin
+    Writeln(F,'Variant has unknown type: ', VargSrc.vType);
+    Exit;
+    end;
+  If VArgSrc.vType<>varEmpty then  
+    With VArgSrc do
+      begin
+      Write(F,'Value is: ') ;
+      Case vtype of 
+        varnull : Write(F,'Null');
+        varsmallint : Write(F,vsmallint);
+        varinteger : Write(F,vinteger);
+        varsingle : Write(F,vsingle);
+        vardouble : Write(F,vdouble);
+        varcurrency : Write(F,vcurrency) ;
+        vardate : Write(F,vdate) ;
+        varolestr : Write(F,'Not supported') ;
+        vardispatch : Write(F,'Not suppordted') ;
+        varerror : Write(F,'Error') ;
+        varboolean : Write(F,vboolean) ;
+        varvariant : Write(F,'Unsupported') ;
+        varunknown : Write(F,'Unsupported') ;
+        vardecimal : Write(F,'Unsupported') ;
+        varshortint : Write(F,vshortint) ;
+        varbyte : Write(F,vbyte) ;
+        varword : Write(F,vword) ;
+        varlongword : Write(F,vlongword) ;
+        varint64 : Write(F,vint64) ;
+        varqword : Write(F,vqword) ;
+      end;
+      Writeln(f); 
+      end;
+end;
+
 {$endif HASVARIANT}
 {
   $Log$
-  Revision 1.4  2001-08-19 21:02:02  florian
+  Revision 1.5  2001-11-14 23:00:17  michael
+  + First working variant support
+
+  Revision 1.4  2001/08/19 21:02:02  florian
     * fixed and added a lot of stuff to get the Jedi DX( headers
       compiled