mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 10:50:59 +02:00
+ First working variant support
This commit is contained in:
michael
parent
2a27de0fb0
commit
d703757d27
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,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);
|
||||
@ -90,6 +120,34 @@ 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;
|
||||
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);
|
||||
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;
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user