Ответ 1
С помощью типов ObjAuto.pas и invokable вариантов это должно быть возможно (написано в XE, но должно также работать в Delphi 7 или ниже):
unit DuckTyping;
interface
function Duck(Instance: TObject): Variant;
implementation
uses
ObjAuto,
SysUtils,
TypInfo,
Variants;
type
TDuckVarData = packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
VDuck: TObject;
Reserved4: LongWord;
end;
TDuckVariantType = class(TPublishableVariantType)
protected
function GetInstance(const V: TVarData): TObject; override;
public
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean); override;
function DoFunction(var Dest: TVarData; const V: TVarData;
const Name: string; const Arguments: TVarDataArray): Boolean; override;
end;
var
DuckVariantType: TDuckVariantType;
{ TDuckVariantType }
procedure TDuckVariantType.Clear(var V: TVarData);
begin
V.VType := varEmpty;
TDuckVarData(V).VDuck := nil;
end;
procedure TDuckVariantType.Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else
begin
with TDuckVarData(Dest) do
begin
VType := VarType;
VDuck := TDuckVarData(Source).VDuck;
end;
end;
end;
function TDuckVariantType.DoFunction(var Dest: TVarData; const V: TVarData;
const Name: string; const Arguments: TVarDataArray): Boolean;
var
instance: TObject;
methodInfo: PMethodInfoHeader;
paramIndexes: array of Integer;
params: array of Variant;
i: Integer;
ReturnValue: Variant;
begin
instance := GetInstance(V);
methodInfo := GetMethodInfo(instance, ShortString(Name));
Result := Assigned(methodInfo);
if Result then
begin
SetLength(paramIndexes, Length(Arguments));
SetLength(params, Length(Arguments));
for i := Low(Arguments) to High(Arguments) do
begin
paramIndexes[i] := i + 1;
params[i] := Variant(Arguments[i]);
end;
ReturnValue := ObjectInvoke(instance, methodInfo, paramIndexes, params);
if not VarIsEmpty(ReturnValue) then
VarCopy(Variant(Dest), ReturnValue);
end
else
begin
VarClear(Variant(Dest));
end;
end;
function TDuckVariantType.GetInstance(const V: TVarData): TObject;
begin
Result := TDuckVarData(V).VDuck;
end;
function Duck(Instance: TObject): Variant;
begin
TDuckVarData(Result).VType := DuckVariantType.VarType;
TDuckVarData(Result).VDuck := Instance;
end;
initialization
DuckVariantType := TDuckVariantType.Create;
finalization
FreeAndNil(DuckVariantType);
end.
Вы можете просто использовать его так:
type
{$METHODINFO ON}
TDuck = class
public // works in XE, not sure if it needs to be published in older versions
procedure Quack;
end;
procedure TDuck.Quack;
begin
ShowMessage('Quack');
end;
procedure DoSomething(D: Variant);
begin
D.Quack;
end;
var
d: TDuck;
begin
d := TDuck.Create;
try
DoSomething(Duck(d));
finally
d.Free;
end;
end;