paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 18:10:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* a few more simple handlers get custom variant intercepts. Also part of #39815

Browse Source
This commit is contained in:
marcoonthegit 2022-08-21 18:43:34 +02:00
parent 3eb800fac6
commit 83b4555511
1 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
packages/rtl-objpas/src/inc/variants.pp
View File

@ -696,12 +696,20 @@ end;
function sysvartocurr (const v : Variant) : Currency; function sysvartocurr (const v : Variant) : Currency;
var Handler: TCustomVariantType;
dest: TVarData;
begin begin
if VarType(v) = varNull then if VarType(v) = varNull then
if NullStrictConvert then if NullStrictConvert then
VarCastError(varNull, varCurrency) VarCastError(varNull, varCurrency)
else else
Result := 0 Result := 0
else if FindCustomVariantType(TVarData(v).vType, Handler) then
begin
VariantInit(dest);
Handler.CastTo(dest, TVarData(v), varCurrency);
Result := dest.vcurrency;
end
else else
Result := VariantToCurrency(TVarData(V)); Result := VariantToCurrency(TVarData(V));
end; end;
@ -745,12 +753,20 @@ end;
procedure sysvartowstr (var s : WideString; const v : Variant); procedure sysvartowstr (var s : WideString; const v : Variant);
var Handler: TCustomVariantType;
dest: TVarData;
begin begin
if VarType(v) = varNull then if VarType(v) = varNull then
if NullStrictConvert then if NullStrictConvert then
VarCastError(varNull, varOleStr) VarCastError(varNull, varOleStr)
else else
s := NullAsStringValue s := NullAsStringValue
else if FindCustomVariantType(TVarData(v).vType, Handler) then
begin
VariantInit(dest);
Handler.CastTo(dest, TVarData(v), varOleStr);
s:= dest.volestr;
end
else else
S := VariantToWideString(TVarData(V)); S := VariantToWideString(TVarData(V));
end; end;
@ -817,13 +833,21 @@ end;
{$ifndef FPUNONE} {$ifndef FPUNONE}
function sysvartotdatetime (const v : Variant) : TDateTime; function sysvartotdatetime (const v : Variant) : TDateTime;
var Handler: TCustomVariantType;
dest: TVarData;
begin begin
if VarType(v) = varNull then if VarType(v) = varNull then
if NullStrictConvert then if NullStrictConvert then
VarCastError(varNull, varDate) VarCastError(varNull, varDate)
else else
Result := 0 Result := 0
else else if FindCustomVariantType(TVarData(v).vType, Handler) then
begin
VariantInit(dest);
Handler.CastTo(dest, TVarData(v), vardate);
Result := dest.vdate;
end
else
Result:=VariantToDate(TVarData(v)); Result:=VariantToDate(TVarData(v));
end; end;
{$endif} {$endif}