多线程 **

Mephist

顶下。。。

lisb

这样就可以了
unit MainForm;

interface

uses
  Business.System, Business.Forms, Business.Model,Business.data;

var
  ss: String;
  lCT1Form: TCT1Form;
type
  TMyThread = class(TThread)
  private
    FForm: TMainForm;
  public
    procedure Execute; override;
    property Form: TMainForm read FForm write FForm;
  end;

type
  TMainForm = class(TForm)
    DataNavigator1: TDataNavigator;
    DataSetBroker1: TDataSetBroker;
    InfoBroker1: TInfoBroker;
    FuncBroker1: TFuncBroker;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    DataGrid1: TDataGrid;
    DataGrid1CARDCODE: TDataGridColumn;
    DataGrid1CARDNAME: TDataGridColumn;
    DataGrid1CARDTYPE: TDataGridColumn;
    DataGrid1MAILADDRES: TDataGridColumn;
    DataGrid1MAILZIPCOD: TDataGridColumn;
    DataGrid1PHONE1: TDataGridColumn;
    DataGrid1PHONE2: TDataGridColumn;
    DataGrid1BDSJSZD1: TDataGridColumn;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    TabSheet2: TTabSheet;
    DataSetBroker2: TDataSetBroker;
    DataGrid2: TDataGrid;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
  private
    {private declarations}
    procedure showCT1Form;
  public
    {public declarations}
  end;

implementation

procedure TMyThread.Execute;
var
  i: Integer;
  l: Integer;
begin
    Synchronize(FForm.ShowCT1Form);   //同步显示
    for i:=0 to 10000 do
    begin
      for l:=0 to 20 do
      begin
        ss := SysUtils.IntToStr(i);
        Forms.Application.ProcessMessages;   //注意需要
      end
    end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  t: TMyThread;
begin
  t := TMyThread.Create(True);
  lCT1Form := TCT1Form.Create(Context) ;
  t.Form := Self ;
  t.execute;
  lCT1Form.Free ;
end;

procedure TMainForm.showCT1Form;
begin
  lCT1Form.Show;
end;

Mephist

这是您说的11楼的方法么？？
我试过了，能显示Label的默认caption
我放了个Timer做计时器，动态给Label赋值，是不行的

lisb

看22楼，把里边的代码调一下就明白了

Mephist

应该差不多。。。

unit SJWG1;

interface

uses
  Business.System, Business.Model, Business.Forms, Business.Data;


var
  ss: String;
  lForm : TCT1 ;
type
  TSJWG1 = class(TFormDoc)
    InfoBroker: TInfoBroker;
    DataSetBrokerBZSJJ1: TDataSetBroker;
    GroupBox1: TGroupBox;
    Button1: TButton;
    DataGridASSETCODE: TDataGridColumn;
    DataGridASSETNAME: TDataGridColumn;
    DataGridASSETSPEC: TDataGridColumn;
    DataGridASSETUNIT: TDataGridColumn;
    DataGridASSETNUM: TDataGridColumn;
    DataGridASSETPRICE: TDataGridColumn;
    DataGridDEPTID: TDataGridColumn;
    DataGridADDRESS: TDataGridColumn;
    DataGridBUYDATE: TDataGridColumn;
    DataGridBEGINUSEDATE: TDataGridColumn;
    DataGridUSEDYEARLIMIT: TDataGridColumn;
    DataGridORIGINALVALUE: TDataGridColumn;
    DataGridUSEMAN: TDataGridColumn;
    DataGridSTATUS: TDataGridColumn;
    DataGridREMARK: TDataGridColumn;
    Button2: TButton;
    Button3: TButton;
    DataGrid: TDataGrid;
    procedure Button1Click(Sender: TObject);
  private
    {private declarations}
    procedure showCT1Form;
  public
    {public declarations}
//    Procedure ExportToExcel(DataGrid : TDataGrid ; FileName : string ) ;
  end;

type
  TMyThread = class(TThread)
  private
    FForm: TSJWG1;
  public
    procedure Execute; override;
    property Form: TSJWG1 read FForm write FForm;
  end;


implementation

procedure TSJWG1.Button1Click(Sender: TObject);
var
  t: TMyThread;
begin
  t := TMyThread.Create(True);
  lForm := TCT1.Create(Context) ;
  t.Form := Self ;
  t.Execute  ;
  lForm.Free ;
end;
procedure TMyThread.Execute;
var
  i: Integer;
  l: Integer;
begin
  try
   Synchronize(FForm.ShowCT1Form);   //同步显示
   Forms.Application.ProcessMessages ;
   FForm.DataGrid.SaveToXLS('c:\test.xls' , true ) ;

  except
  end;
end;

procedure TSJWG1.showCT1Form;
begin
  lForm.Show;
end;

end.

alang

楼上的做法是错误的。
关键点在调用线程的Resume方法来执行，而不是调用Execute方法来执行，Execute是线程内部调用的。直接调用这个方法，就不是在线程中执行了，而是在主线程执行了。

而ProcessMessage只是在主线程中主动放弃控制权，去处理消息，不是真正的多线程。

请看例子：
unit MainForm;

interface

uses
  Business.System, Business.Forms;

type
  TMainForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure BizFormDestroy(Sender: TObject);
  private
    {private declarations}
    t: TMyThread;
  public
    {public declarations}
  end;

implementation

type
  TMyThread = class(TThread)
  public
    myForm: TMainForm;
    ss: String;
    procedure Execute; override;
    procedure ShowChanges;
  end;

procedure TMyThread.ShowChanges;
begin
  if Terminated  then Exit;
  if Assigned(myForm) then
    myForm.Label1.Caption := ss;
end;

procedure TMyThread.Execute;
var
  i: Integer;
  l: Integer;
begin
  try
    for i:=0 to 65535 do
    begin
      if Terminated then Exit;
      l := i;
      l := 2*l;
      for l:=0 to 65535 do ;
      ss := SysUtils.IntToStr(i);
      Synchronize(ShowChanges);
    end;
  except
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  t := TMyThread.Create(True);
  t.myForm := Self;
  t.Resume;
end;

procedure TMainForm.BizFormDestroy(Sender: TObject);
begin
  t.Terminate;
end;

end.

Mephist

您这个我倒是看明白了，不知道怎么该成我要的
我要在当前窗体的导数据操作完成后自动terminate怎么写？？
您能不能根据我的需求写一个咯？

alang

procedure TMyThread.Execute;
var
  i: Integer;
  l: Integer;
begin
  try
    myForm := TForm.Create(nil);
  //这里创建ProgressBar等对象
    myForm.Show;
    for i:=0 to 65535 do
    begin
      if Terminated then Exit;
      l := i;
      l := 2*l;
      for l:=0 to 65535 do ;
      ss := SysUtils.IntToStr(i);
      Synchronize(ShowChanges);
    end;
    myForm.Free;
  except
  end;
end;

procedure TMyThread.ShowChanges;
begin
  if Terminated  then Exit;
  myForm.ProgressBar.StepIt;
end;

李涛

28楼的兄弟，你这种做法在DELPHI中是行不通的，你不能在线程执行方法中显示窗体，显示窗体会重绘界面，这会主线程产生冲突

李涛

凡是需要绘制界面的方法都要包括在Synchronize（method）中，主要就是要必免线程访问资源冲突