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

Ответы (0 шт):