Показать сообщение отдельно
  #6  
Старый 02.12.2024, 08:11
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,087
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Непонятно что конкретно тебе надо сделать. Точнее в чем проблема.
Вот более полный пример:

Форма:
Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit2, Unit3, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btAddStr1: TButton;
    btAddStr2: TButton;
    btAddStr3: TButton;
    btCall: TButton;
    procedure btAddStr1Click(Sender: TObject);
    procedure btAddStr2Click(Sender: TObject);
    procedure btAddStr3Click(Sender: TObject);
    procedure btCallClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Buf : TParamsColleator;
    procedure AddStrToBuf(S : String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddStrToBuf(S: String);
begin
  if Not Assigned(Buf) then Buf := TParamsColleator.Create;
  Buf.Add(S);
end;

procedure TForm1.btAddStr1Click(Sender: TObject);
begin
  AddStrToBuf('Str1');
end;

procedure TForm1.btAddStr2Click(Sender: TObject);
begin
  AddStrToBuf('Str2');
end;

procedure TForm1.btAddStr3Click(Sender: TObject);
begin
  AddStrToBuf('Str3');
end;

procedure TForm1.btCallClick(Sender: TObject);
var
  Intf : IComDemoInterface;
  params : OleVariant;
begin
  If Not Assigned(Buf) Then raise Exception.Create('Buf is empty. Add values first.');

  Intf := TComDemoImpl.Create;
  Try
    params := Buf.GetParamsArray;
    Intf.ProcessArray(params);
  Finally
    Intf := Nil;
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Buf := Nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  If Assigned(Buf) Then FreeAndNil(Buf);

end;

end.

Интерфейс с имплементацией:
Код:
unit Unit2;

interface

type
  IComDemoInterface = interface(IUnknown)
    ['{00000000-0000-ABCD-0000-000000000001}']
    procedure ProcessArray(arr: OleVariant); safecall;
  end;

  TComDemoImpl = class(TInterfacedObject, IComDemoInterface)
    procedure ProcessArray(arr: OleVariant); safecall;
  end;

implementation

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants;
{ TComDemoImpl }

procedure TComDemoImpl.ProcessArray(arr: OleVariant);
var
  I : Integer;
  S : String;
begin
  If Not VarIsArray(arr)
    Then MessageBox(0,PChar('<no data>'),PChar('Received call, but param is not array:'),0)
    Else
      Begin
        S := '';
        For I := VarArrayLowBound(arr,1) To VarArrayHighBound(arr,1) Do
          If VarIsStr(arr[i])
            Then S := S + IntToStr(I) + ' : ' + arr[i] + #10#13
            Else S:= S + IntToStr(I) + ' : <not string>' + #10#13;
        MessageBox(0,PChar(S),PChar('Received call:'),0);
      End;
end;

end.

Аккумулятор для параметров (самый простейший, просто унаследовался от TStringList и добаил свою функцию):
Код:
unit Unit3;

interface

uses
  System.SysUtils, System.Variants, System.Classes;

type
  TParamsColleator=class(TStringList)
  public
    function GetParamsArray : OleVariant;
  end;

implementation

{ TParamsColleator }

function TParamsColleator.GetParamsArray: OleVariant;
var
  I : Integer;
begin
  Result :=  VarArrayCreate([0,Count-1],varOleStr);
  For I := 0 To Count-1 Do
    Result[i] := Strings[i];
end;

end.
Ответить с цитированием