СОМ-объект. Внутрипроцессорный СА. TCS 5.0.2. D7.

library PJAEServer;

uses
  ComServ,
  UForm1 in 'UForm1.pas' {Form1},
  PJAEServer_TLB in 'PJAEServer_TLB.pas',
  UMetods in 'UMetods.pas' {CreateForm: CoClass};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.
unit UMetods;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, PJAEServer_TLB, StdVcl
  ,UForm1;

type
  TCreateForm = class(TAutoObject, ICreateForm)
  protected
    NButton: Integer;
    F:TForm1;
  protected
    procedure Form(TCSApp0, ActMo0, Attr1, ArrForm: OleVariant); safecall;
    function Get_NButton: Integer; safecall;
    procedure Set_NButton(NButton: Integer); safecall;

  end;

implementation

uses Windows, ComServ, Messages, Dialogs, SysUtils, WinTypes, Variants, StdCtrls
  , WinProcs, Classes, Graphics, Controls, Forms, ComCtrls;

procedure TCreateForm.Form(TCSApp0, ActMo0, Attr1, ArrForm: OleVariant);
begin
  ShowWindow (Application.handle, SW_HIDE);//Скрыть окно приложения
  F:=TForm1.Create(nil);
  F.TCSApp:=TCSApp0;
  F.ActMo:=ActMo0;
  F.Caption:=ArrForm;
  F.Attr:=Attr1;
  F.ShowModal;
  F.Attr.ShowModal; //ОБЪЕКТ НЕДОСТУПЕН
  F.Free;
  F:=nil;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TCreateForm, Class_CreateForm,
    ciMultiInstance, tmApartment);
end.

unit UForm1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, ImgList, Buttons;

type
  TForm1 = class(TForm)

. . . . .

    procedure Button1Click(Sender: TObject);
    procedure StrGgrdDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    TCSApp,ActMo, Attr:OleVariant;
    StringofCode:string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormShow(Sender: TObject);
var i,j, n:Integer;
begin
  StrGgrd.Cells[0,0]:=' №№';
  StrGgrd.Cells[1,0]:='  Наименование атрибута';
  StrGgrd.Cells[2,0]:='  Значение атрибута';
  Label2.Caption:=ActMo.Properties[5].AsString; //Обозначение
  Label3.Caption:=ActMo.Properties[20].AsString; //Обозначение
  Label6.Caption:=ActMo.Properties[17].AsString; //Обозначение
  Label7.Caption:=ActMo.Properties[16].AsString; //Обозначение
  n:=0;
  try
    Attr.ShowModal;
    Attr.First;
    while not Attr.Eof do
    begin
        Inc(n); Attr.Next;
    end;
    Attr.First;
  except
    ShowMessage('Count='+IntToStr(n));
  end;

    Set    MainLib=CreateObject("PServer.CreateForm")
    If MainLib Is Nothing Then 
        Call TCSApp.ShowErrorMessage("Отсутствует библиотека PServer.dll")
        Exit Sub
    End If             
    n=0
‘Создаю объект список атрибутов
    Set Attr = TCSActiveModule.ChildModules.ModuleByName("PrjVerParams").AsIDispatch
    Do While Not Attr.Eof
        n=n+1
        Attr.Next
    Loop
    k=Attr.ShowModal(cStr(n)) ' Показывает список атрибутов и их кол-во правильно
    If  Not Attr Is Nothing Then 
        MainLib.Form TCSApp, TCSActiveModule, Attr, "Мы работаем из PServer.dll"
    End If