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

* big variant from Thorsten Engler, fixes and improves several variant stuff

Browse Source 
git-svn-id: trunk@6747 -
This commit is contained in:
florian 2007-03-07 20:45:06 +00:00
parent b06b453ee1
commit a99b5470af
5 changed files with 1350 additions and 583 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1869
rtl/objpas/cvarutil.inc
View File

File diff suppressed because it is too large Load Diff

7
rtl/objpas/fmtbcd.pp
View File

@ -1633,9 +1633,10 @@ IMPLEMENTATION
{$else}
BCD.Places := 4;
{$endif}
CurrToBCD := False;
if Decimals <> 4
then NormalizeBCD ( BCD, BCD, Precision, Decimals );
if Decimals <> 4 then
Result := NormalizeBCD ( BCD, BCD, Precision, Decimals )
else
CurrToBCD := True;
end;
{$ifdef comproutines}

2
rtl/objpas/sysconst.pp
View File

@ -70,6 +70,8 @@ resourcestring
SInvalidVarCast = 'Invalid variant type cast';
SInvalidVarNullOp = 'Invalid NULL variant operation';
SInvalidVarOp = 'Invalid variant operation';
SInvalidBinaryVarOp = 'Invalid variant operation %s %s %s';
SInvalidUnaryVarOp = 'Invalid variant operation %s %s';
SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'+LineEnding+'%s';
SNoError = 'No error.';
SNoThreadSupport = 'Threads not supported. Recompile program with thread driver.';

51
rtl/objpas/varutilh.inc
View File

@ -48,25 +48,39 @@ function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
{ Conversion routines NOT in windows oleaut }
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;
Function VariantToWideString(Const VargSrc : TVarData) : WideString;
Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
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;
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);
Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
procedure DumpVariant(const VSrc : Variant);
procedure DumpVariant(const aName: string; const VSrc : Variant);
procedure DumpVariant(var F : Text; const VSrc : Variant);
procedure DumpVariant(var F : Text; const aName: string; const VSrc : Variant);
procedure DumpVariant(const VArgSrc : TVarData);
procedure DumpVariant(const aName: string; const VArgSrc : TVarData);
procedure DumpVariant(var F : Text; const VArgSrc : TVarData);
procedure DumpVariant(var F : Text; const aName: string; const VArgSrc : TVarData);
{$IFDEF DEBUG_VARUTILS}
var
__DEBUG_VARUTILS: Boolean;
{$ENDIF}
{$i varerror.inc}
@ -79,4 +93,7 @@ const
ARR_DISPATCH = $0400;
ARR_VARIANT = $0800;
VAR_LOCALE_USER_DEFAULT = $400; // = Windows.LOCALE_USER_DEFAULT

4
rtl/objpas/varutils.inc
View File

@ -17,7 +17,7 @@
Some general stuff: Error handling and so on.
---------------------------------------------------------------------}
{ we so ugly things with tvararray here }
{ we do ugly things with tvararray here }
{$RANGECHECKS OFF}
Procedure SetUnlockResult (P : PVarArray; Res : HResult);
@ -759,3 +759,5 @@ begin
Result:=psa^.ElementSize;
end;