paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 21:10:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* implemented VarSupports helpers

Browse Source 
git-svn-id: trunk@11846 -
This commit is contained in:
ivost 2008-10-01 21:34:48 +00:00
parent 1fe90fe7dc
commit 1ec2bf7f94
1 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/inc/variants.pp
View File

@ -3024,20 +3024,35 @@ function VarAsError(AResult: HRESULT): Variant;
end;
{$warnings off}
function VarSupports(const V: Variant; const IID: TGUID; out Intf): Boolean;
begin
NotSupported('VarSupports');
case TVarData(v).vType of
varUnknown:
Result := IInterface(TVarData(v).vUnknown).QueryInterface(IID, Intf) = S_OK;
varUnknown or varByRef:
Result := IInterface(TVarData(v).vPointer^).QueryInterface(IID, Intf) = S_OK;
varDispatch:
Result := IInterface(TVarData(v).vDispatch).QueryInterface(IID, Intf) = S_OK;
varDispatch or varByRef:
Result := IInterface(TVarData(v).vPointer^).QueryInterface(IID, Intf) = S_OK;
varVariant, varVariant or varByRef:
Result := Assigned(TVarData(v).vPointer) and VarSupports(Variant(PVarData(TVarData(v).vPointer)^), IID, Intf);
else
Result := False;
end;
end;
function VarSupports(const V: Variant; const IID: TGUID): Boolean;
var
Dummy: IInterface;
begin
NotSupported('VarSupports');
Result := VarSupports(V, IID, Dummy);
end;
{ Variant copy support }
{$warnings off}
procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
begin