unit1.~pas

多线程调用的范例

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uThreadedInterfaces, uThreadedDataModuleStatus, StdCtrls,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    memParams: TMemo;
    cboApplications: TEdit;
    cboActions: TEdit;
    Memo1: TMemo;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
     FCurrentModule: IThreadedDataModule;
     tds_Action: TThreadedDataModuleStatus;
     procedure tds_ActionStatusMessage(Sender: TObject;
  StatusMessage: String);  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
  tds_Action.ModuleDLL:=cboApplications.Text;
  tds_Action.ModuleName:=cboActions.Text;
  tds_Action.DisplayOptions :=[tdStatusBar, tdStatusMessage,
                            tdPauseThread, tdCancelThread];
  tds_Action.OnStatusMessage :=  tds_ActionStatusMessage;
  FCurrentModule:=tds_Action.CreateModule;
  if FCurrentModule = nil then Exit; // NTI: message?
  for i:=0 to memParams.lines.count-1 do
   FCurrentModule.SetParamByName(memParams.Names[i], memParams.Values[memParams.Names[i]]);
  FCurrentModule.Execute;
  FCurrentModule:=nil;
end;

procedure TForm1.tds_ActionStatusMessage(Sender: TObject;
  StatusMessage: String);
begin
  Memo1.Lines.Add(StatusMessage);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  tds_Action:=TThreadedDataModuleStatus.create(PANEL1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FCurrentModule:=nil;
  tds_Action.Free;
end;

end.