Delphi - implements directive does not work in 64 bit version
В Delphi можно делегировать имплементацию интерфейса свойству класса. В примере класс TImplementator реализует контракт IImplementsInterface, агрегируя класс - его реальный имплементатор (TImplementsForm), следя также за временем его жизни. В методе ButtonTestClick показано, что это работает (и давно, с десятками интерфейсов) под Win32. Под Win64 работает вызов процедур, при вызове функций получаем исключение (AV)
Как добиться результата под Win64
IImplementsInterface = interface
['{8E978167-9C0C-414F-BBE8-037D6D865575}']
function GetResultAV: Integer;
procedure TestOk;
end;
TImplementsForm = class(TForm, IImplementsInterface)
ButtonTest: TButton;
procedure ButtonTestClick(Sender: TObject);
protected
{ IImplementsInterface }
function GetResultAV: Integer;
procedure TestOk;
public
end;
TComponentAggregator<T: TComponent> = class(TInterfacedObject)
private
FComponent: T;
public
constructor Create;
destructor Destroy; override;
end;
TCustomImplementator<T: TComponent> = class(TComponentAggregator<T>, IImplementsInterface)
private
function GetImplementator: IImplementsInterface;
protected
property Implementator: IImplementsInterface read GetImplementator implements IImplementsInterface;
end;
TImplementator = class(TCustomImplementator<TImplementsForm>, IImplementsInterface);
var
ImplementsForm: TImplementsForm;
implementation
{$R *.dfm}
{ TComponentAggregator<T> }
constructor TComponentAggregator<T>.Create;
begin
inherited Create;
FComponent := T.Create(nil);
end;
destructor TComponentAggregator<T>.Destroy;
begin
FComponent.Free;
inherited Destroy;
end;
{ TImplementator }
function TCustomImplementator<T>.GetImplementator: IImplementsInterface;
begin
Supports(FComponent, IImplementsInterface, Result);
end;
{ TImplementsForm }
procedure TImplementsForm.ButtonTestClick(Sender: TObject);
begin
var LImplementsInterface: IImplementsInterface := TImplementator.Create; // LImplementsInterface - TImplementator as IImplementsInterface
LImplementsInterface.TestOk; // Ok x32, ok x64
var LResult := LImplementsInterface.GetResultAV; // Ok x32, ACCESS_VIOLATION x64
end;
function TImplementsForm.GetResultAV: Integer;
begin
Result := -1;
end;
procedure TImplementsForm.TestOk;
begin
ShowMessage('TImplementsForm.Test');
end