paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 18:29:13 +02: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} {$else}
BCD.Places := 4; BCD.Places := 4;
{$endif} {$endif}
CurrToBCD := False; if Decimals <> 4 then
if Decimals <> 4 Result := NormalizeBCD ( BCD, BCD, Precision, Decimals )
then NormalizeBCD ( BCD, BCD, Precision, Decimals ); else
CurrToBCD := True;
end; end;
{$ifdef comproutines} {$ifdef comproutines}

2
rtl/objpas/sysconst.pp
View File

@ -70,6 +70,8 @@ resourcestring
SInvalidVarCast = 'Invalid variant type cast'; SInvalidVarCast = 'Invalid variant type cast';
SInvalidVarNullOp = 'Invalid NULL variant operation'; SInvalidVarNullOp = 'Invalid NULL variant operation';
SInvalidVarOp = 'Invalid 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'; SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'+LineEnding+'%s';
SNoError = 'No error.'; SNoError = 'No error.';
SNoThreadSupport = 'Threads not supported. Recompile program with thread driver.'; 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 } { Conversion routines NOT in windows oleaut }
Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt; function VariantToSmallInt(const VargSrc : TVarData) : SmallInt;
Function VariantToLongint(Const VargSrc : TVarData) : Longint; function VariantToLongint(const VargSrc : TVarData) : Longint;
Function VariantToShortint(Const VargSrc : TVarData) : ShortInt; function VariantToShortint(const VargSrc : TVarData) : ShortInt;
Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal; function VariantToCardinal(const VargSrc : TVarData) : Cardinal;
Function VariantToSingle(Const VargSrc : TVarData) : Single; function VariantToSingle(const VargSrc : TVarData) : Single;
Function VariantToDouble(Const VargSrc : TVarData) : Double; function VariantToDouble(const VargSrc : TVarData) : Double;
Function VariantToCurrency(Const VargSrc : TVarData) : Currency; function VariantToCurrency(const VargSrc : TVarData) : Currency;
Function VariantToDate(Const VargSrc : TVarData) : TDateTime; function VariantToDate(const VargSrc : TVarData) : TDateTime;
Function VariantToBoolean(Const VargSrc : TVarData) : Boolean; function VariantToBoolean(const VargSrc : TVarData) : Boolean;
Function VariantToByte(Const VargSrc : TVarData) : Byte; function VariantToByte(const VargSrc : TVarData) : Byte;
Function VariantToInt64(Const VargSrc : TVarData ) : Int64; function VariantToInt64(const VargSrc : TVarData ) : Int64;
Function VariantToQWord(Const VargSrc : TVarData ) : Qword; function VariantToQWord(const VargSrc : TVarData ) : Qword;
Function VariantToWideString(Const VargSrc : TVarData) : WideString; function VariantToWideString(const VargSrc : TVarData) : WideString;
Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString; function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
Function VariantToShortString(Const VargSrc : TVarData) : ShortString; function VariantToShortString(const VargSrc : TVarData) : ShortString;
{Debug routines } {Debug routines }
Procedure DumpVariant(Const VArgSrc : TVarData); procedure DumpVariant(const VSrc : Variant);
Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData); 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} {$i varerror.inc}
@ -79,4 +93,7 @@ const
ARR_DISPATCH = $0400; ARR_DISPATCH = $0400;
ARR_VARIANT = $0800; 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. Some general stuff: Error handling and so on.
---------------------------------------------------------------------} ---------------------------------------------------------------------}
{ we so ugly things with tvararray here } { we do ugly things with tvararray here }
{$RANGECHECKS OFF} {$RANGECHECKS OFF}
Procedure SetUnlockResult (P : PVarArray; Res : HResult); Procedure SetUnlockResult (P : PVarArray; Res : HResult);
@ -759,3 +759,5 @@ begin
Result:=psa^.ElementSize; Result:=psa^.ElementSize;
end; end;