Всем доброго времени суток!
Случилась тут идея, начать работать с программой через фабрику объектов автоматизации, то есть через TAutoObjectFactory.
Всё хорjшо, создаю tlb файл, автоматически создаются нужные модули и классы. НО! Тут случился затык. Захотелось мне из одного интерфейса выдать ссылку на другой!
Это описание интерфейсов, что сгенерил мне Delphi.
Код:
unit Project1_TLB;
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
interface
uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
const
// TypeLibrary Major and minor versions
Project1MajorVersion = 1;
Project1MinorVersion = 0;
LIBID_Project1: TGUID = '{8AC60C65-AB4D-4D5D-934E-6D3C020B121A}';
IID_IMyFormApp: TGUID = '{0AFD9D9D-8D9A-43BC-A157-5DE6FD91A091}';
CLASS_MyFormApp: TGUID = '{EB89C977-2195-4ED4-B79D-87A15D0ACBD6}';
IID_ILabel: TGUID = '{A5211E59-26A9-41ED-9AA6-A7E6A47833A6}';
CLASS_Label_: TGUID = '{F81BB15D-005B-46B4-B8BA-838180C0750F}';
type
IMyFormApp = interface;
IMyFormAppDisp = dispinterface;
ILabel = interface;
ILabelDisp = dispinterface;
MyFormApp = IMyFormApp;
Label_ = ILabel;
IMyFormApp = interface(IDispatch)
['{0AFD9D9D-8D9A-43BC-A157-5DE6FD91A091}']
function Label_: ILabel; stdcall;
end;
IMyFormAppDisp = dispinterface
['{0AFD9D9D-8D9A-43BC-A157-5DE6FD91A091}']
function Label_: ILabel; dispid 202;
end;
ILabel = interface(IUnknown)
['{A5211E59-26A9-41ED-9AA6-A7E6A47833A6}']
function Get_Caption: WideString; safecall;
procedure Set_Caption(const Value: WideString); safecall;
property Caption: WideString read Get_Caption write Set_Caption;
end;
ILabelDisp = dispinterface
['{A5211E59-26A9-41ED-9AA6-A7E6A47833A6}']
property Caption: WideString dispid 201;
end;
CoMyFormApp = class
class function Create: IMyFormApp;
class function CreateRemote(const MachineName: string): IMyFormApp;
end;
CoLabel_ = class
class function Create: ILabel;
class function CreateRemote(const MachineName: string): ILabel;
end;
implementation
uses System.Win.ComObj;
class function CoMyFormApp.Create: IMyFormApp;
begin
Result := CreateComObject(CLASS_MyFormApp) as IMyFormApp;
end;
class function CoMyFormApp.CreateRemote(const MachineName: string): IMyFormApp;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MyFormApp) as IMyFormApp;
end;
class function CoLabel_.Create: ILabel;
begin
Result := CreateComObject(CLASS_Label_) as ILabel;
end;
class function CoLabel_.CreateRemote(const MachineName: string): ILabel;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Label_) as ILabel;
end;
end.
Это реализация интерфейсов CoClass.
Код:
unit Unit2;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
System.Win.ComObj, Project1_TLB, System.Win.StdVcl;
type
TCLabel = class;
TMyFormApp = class(TAutoObject, IMyFormApp)
private
fILabs: TCLabel;
protected
function Label_: ILabel; stdcall;
public
procedure Initialize; override;
destructor Destroy; override;
end;
TCLabel = class(TAutoObject, ILabel)
protected
function Get_Caption: WideString; safecall;
procedure Set_Caption(const Value: WideString); safecall;
end;
implementation
uses System.Win.ComServ, Unit1;
destructor TMyFormApp.Destroy;
begin
fILabs.Free;
inherited;
end;
procedure TMyFormApp.Initialize;
begin
inherited;
fILabs := nil;
end;
function TMyFormApp.Label_: ILabel;
begin
if not Assigned(fILabs) then
fILabs := TCLabel.Create;
Result := fILabs;
end;
{ TCLabel }
function TCLabel.Get_Caption: WideString;
begin
Result := Form1.Label1.Caption;
end;
procedure TCLabel.Set_Caption(const Value: WideString);
begin
Form1.Label1.Caption := Value;
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyFormApp, Class_MyFormApp, ciSingleInstance, tmBoth);
TAutoObjectFactory.Create(ComServer, TCLAbel, CLASS_Label_, ciSingleInstance, tmBoth);
end.
И вот когда я вызываю
Код:
function TMyFormApp.Label_: ILabel;
begin
if not Assigned(fILabs) then
fILabs := TCLabel.Create;
Result := fILabs;
end;
У меня появляется такое сообщение:
Цитата:
Method 'Label' of object 'IMyFormApp' failed
|
Я понимаю, что я делаю что-то не правильно. Но я не понимаю что!
Заранее спасибо.
P.S. вызов интерфейсов осуществляю их MSWord VisualBasic.