paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 05:59:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ Real/Boolean support added, Start of string support

Browse Source
This commit is contained in:
michael 2001-11-15 22:33:14 +00:00
parent 09c8fc2184
commit a62da4ea8f
3 changed files with 83 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
rtl/objpas/cvarutil.inc
View File

@ -328,10 +328,10 @@ begin
VarSmallInt: Result:=VSmallInt;
VarShortInt: Result:=VShortInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=FloatToCurr(VSingle);
VarDouble : Result:=FloatToCurr(VDouble);
VarSingle : Result:=Trunc(VSingle);
VarDouble : Result:=Trunc(VDouble);
VarCurrency: Result:=VCurrency;
VarDate : Result:=FloatToCurr(VDate);
VarDate : Result:=Trunc(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
@ -359,10 +359,10 @@ begin
VarSmallInt: Result:=VSmallint;
VarShortInt: Result:=VShortInt;
VarInteger : Result:=VInteger;
VarSingle : Result:=FloatToCurr(VSingle);
VarDouble : Result:=FloatToCurr(VDouble);
VarSingle : Result:=Trunc(VSingle);
VarDouble : Result:=Trunc(VDouble);
VarCurrency: Result:=VCurrency;
VarDate : Result:=FloatToCurr(VDate);
VarDate : Result:=Trunc(VDate);
VarOleStr : NoWideStrings;
VarBoolean : Result:=Longint(VBoolean);
VarByte : Result:=VByte;
@ -381,10 +381,57 @@ begin
end;
end;
Function VariantToWideString(Const VargSrc : TVarData) : WideString;
Const
BS : Array[Boolean] of WideString = ('False','True');
begin
Try
With VargSrc do
Case (VType and VarTypeMask) of
VarSmallInt : Result:=IntTostr(VSmallint);
VarShortInt : Result:=IntToStr(VShortInt);
VarInteger : Result:=IntToStr(VInteger);
VarSingle : Result:=FloatToStr(VSingle);
VarDouble : Result:=FloatToStr(VDouble);
VarCurrency : Result:=IntToStr(VCurrency);
VarDate : Result:=DateTimeToStr(VDate);
VarOleStr : Result:=WideString(Pointer(VOleStr));
VarBoolean : Result:=BS[VBoolean];
VarByte : Result:=IntToStr(VByte);
VarWord : Result:=IntToStr(VWord);
VarLongWord : Result:=IntToStr(VLongWord);
VarInt64 : Result:=IntToStr(VInt64);
VarQword : Result:=IntToStr(VQWord);
else
VariantTypeMismatch;
end;
except
On EConvertError do
VariantTypeMismatch;
else
Raise;
end;
end;
Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
begin
end;
Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
begin
end;
{$endif HASVARIANT}
{
$Log$
Revision 1.3 2001-11-14 23:00:17 michael
Revision 1.4 2001-11-15 22:33:14 michael
+ Real/Boolean support added, Start of string support
Revision 1.3 2001/11/14 23:00:17 michael
+ First working variant support
Revision 1.2 2001/08/19 21:02:02 florian

8
rtl/objpas/varutilh.inc
View File

@ -144,6 +144,9 @@ Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
Function VariantToByte(Const VargSrc : TVarData) : Byte;
Function VariantToInt64(Const VargSrc : TVarData ) : Int64;
Function VariantToQWord(Const VargSrc : TVarData ) : Qword;
Function VariantToWideString(Const VargSrc : TVarData) : WideString;
Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
{Debug routines }
Procedure DumpVariant(Const VArgSrc : TVarData);
@ -176,7 +179,10 @@ const
{
$Log$
Revision 1.3 2001-11-14 23:00:17 michael
Revision 1.4 2001-11-15 22:33:14 michael
+ Real/Boolean support added, Start of string support
Revision 1.3 2001/11/14 23:00:17 michael
+ First working variant support
Revision 1.2 2001/08/19 21:02:02 florian

30
rtl/objpas/varutils.inc
View File

@ -30,6 +30,20 @@ begin
SafeArrayUnlock(P);
end;
Procedure MakeWideString (Var P : PWideChar; W : WideString);
begin
WideString(Pointer(P)):=W;
UniqueString(WideString(P));
end;
Procedure CopyAsWideString (Var PDest : PWideChar; PSource : PWideChar);
begin
WideString(Pointer(PDest)):=WideString(Pointer(PSource));
UniqueString(WideString(PDest));
end;
{ ---------------------------------------------------------------------
Basic variant handling.
---------------------------------------------------------------------}
@ -59,7 +73,7 @@ begin
varCurrency, varDate, varError, varBoolean, varByte,VarShortInt,
varInt64, VarLongWord,VarQWord:;
varOleStr:
NoWideStrings;
WideString(Pointer(VOleStr)):='';
varDispatch,
varUnknown:
NoInterfaces;
@ -93,7 +107,7 @@ begin
varInt64, VarLongWord,VarQWord:
Move(VBytes, VargDest.VBytes, SizeOf(VargDest.VBytes));
varOleStr:
NoWideStrings; // We should copy here...
CopyAsWideString(VargDest.VOleStr,VOleStr);
varDispatch,
varUnknown:
NoInterfaces; // We should bump up reference count here (Addref)
@ -130,7 +144,7 @@ begin
VarLongWord : VargDest.VLongWord:=PCardinal(VPointer)^;
VarQWord : VargDest.VQWord:=PQWord(VPointer)^;
varVariant : Variant(VargDest):=Variant(PVarData(VPointer)^);
varOleStr : NoWideStrings;
varOleStr : CopyAsWideString(VargDest.VOleStr,PVarData(VPointer)^.VoleStr);
varDispatch,
varUnknown : NoInterfaces;
else
@ -141,9 +155,6 @@ begin
Result:=VAR_OK;
end;
Function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData;
LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
var
@ -167,7 +178,7 @@ begin
varDouble : VargDest.VDouble:=VariantToDouble(Tmp);
varCurrency : VargDest.VCurrency:=VariantToCurrency(Tmp);
varDate : VargDest.VDate:=VariantToDate(tmp);
varOleStr : NoWidestrings;
varOleStr : MakeWideString(VargDest.VoleStr, VariantToWideString(tmp));
varDispatch : Result:=VAR_TYPEMISMATCH;
varUnknown : Result:=VAR_TYPEMISMATCH;
varBoolean : VargDest.VBoolean:=VariantToBoolean(Tmp);
@ -812,7 +823,10 @@ end;
{$endif HASVARIANT}
{
$Log$
Revision 1.5 2001-11-14 23:00:17 michael
Revision 1.6 2001-11-15 22:33:14 michael
+ Real/Boolean support added, Start of string support
Revision 1.5 2001/11/14 23:00:17 michael
+ First working variant support
Revision 1.4 2001/08/19 21:02:02 florian