Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Технологии
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 26.02.2023, 14:39
michael2000 michael2000 вне форума
Прохожий
 
Регистрация: 10.07.2010
Сообщения: 7
Репутация: 10
По умолчанию Создание интерфейсов внутри программы

Всем доброго времени суток!
Случилась тут идея, начать работать с программой через фабрику объектов автоматизации, то есть через 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.

Последний раз редактировалось michael2000, 26.02.2023 в 14:46.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:19.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter