Delphi线程

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,LongWaitTrd; type TForm1 = class(TForm) btnSetTask: TButton; btnExitThd: TButton; btnCreateTrd: TButton; procedure btnSetTaskClick(Sender: TObject); procedure btnCreateTrdClick(Sender: TObject); procedure btnExitThdClick(Sender: TObject); private LongWaitThread:TLongWaitTrd; procedure OnThreadMessage(var Message: TMessage); message WM_USER+2000; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.btnSetTaskClick(Sender: TObject); begin if (LongWaitThread<>nil) then PostThreadMessage(LongWaitThread.ThreadID,WM_USER+1000,0,0); end; procedure TForm1.btnCreateTrdClick(Sender: TObject); begin LongWaitThread:=TLongWaitTrd.Create(true); LongWaitThread.MainWin:=Handle; LongWaitThread.Resume; end; procedure TForm1.OnThreadMessage(var Message: TMessage); begin if Message.Msg= WM_USER+2000 then begin Showmessage(String(message.LParam)); end; end; procedure TForm1.btnExitThdClick(Sender: TObject); begin if (LongWaitThread<>nil) then begin if (not LongWaitThread.ExitLongWaitTrd()) then ShowMessage('The thread exited time out'); end; end; end.

线程类：

Delphi(Pascal) code

unit LongWaitTrd; interface uses Classes,Windows,Messages,SyncObjs; type TLongWaitTrd = class(TThread) private FMainWin:THandle; QuitEvent: TEvent; procedure SendFeedBackToMainWin(); procedure DoTheHardWork(); protected procedure Execute; override; public constructor Create(CreateSuspended: Boolean); destructor Destroy; override; function ExitLongWaitTrd():Boolean; published property MainWin:THandle read FMainWin write FMainWin; end; implementation uses Unit1; constructor TLongWaitTrd.Create(CreateSuspended: Boolean); begin inherited Create(CreateSuspended); end; destructor TLongWaitTrd.Destroy; begin inherited; end; procedure TLongWaitTrd.DoTheHardWork(); begin //to do end; procedure TLongWaitTrd.Execute; var Msg: TMsg; begin FreeOnTerminate:=True; //1.长等待型线程示例 // while GetMessage(Msg, 0, 0, 0) do // begin // if (Msg.message=WM_USER+1000) then //任务来了 // begin // DoTheHardWork(); // SendFeedBackToMainWin; // end; // if (Msg.message=WM_QUIT) then // begin // QuitEvent.SetEvent; // Break; // end; // end; //2.长工作型线程示例 // while(true) do // begin // if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then // begin // if (Msg.message=WM_QUIT) then // begin // QuitEvent.SetEvent; // Break; // end; // end; // DoTheHardWork(); // end; end; function TLongWaitTrd.ExitLongWaitTrd; begin Result:=true; QuitEvent:=TEvent.Create(nil,True,False,'QuitEvent'); PostThreadMessage(ThreadID,WM_QUIT,0,0); if (QuitEvent.WaitFor(2000)=wrTimeOut) then Result:=false; QuitEvent.Free ; end; procedure TLongWaitTrd.SendFeedBackToMainWin(); var Status:String; begin if (MainWin<>0) then begin Status:='The data has been processed by thread.'; PostMessage(MainWin,WM_USER+2000,0,Integer(Status)) end; end; end.

--------------------------------------

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls; type TForm1 = class(TForm) Session1: TSession; { 属性SessionName填写为S1 } Database1: TDatabase; { 属性SessionName选择为S1 } Query1: TQuery;{ 属性Database选择为Database1；属性SessionName选择为S1 } DataSource1: TDataSource; { 属性DataSet设置为空 } DBGrid1: TDBGrid; { 属性DataSource选择为DataSource1 } Session2: TSession; { 属性SessionName填写为S2 } Database2: TDatabase; { 属性SessionName选择为S2 } Query2: TQuery;{ 属性Database选择为Database2；属性SessionName选择为S2 } DataSource2: TDataSource; { 属性DataSet设置为空 } DBGrid2: TDBGrid; { 属性DataSource选择为DataSource2 } BtnGoPause: TButton; { 用于执行和挂起线程 } procedure FormCreate(Sender: TObject); { 创建窗体时创建线程对象 } procedure FormDestroy(Sender: TObject); { 销毁窗体时销毁线程对象 } procedure BtnGoPauseClick(Sender: TObject); { 执行线程和挂起线程 } private public end; TThreadQuery = class(TThread) { 声明线程类 } private FQuery: TQuery; { 线程中的查询组件 } FDataSource: TDataSource; { 与查询组件相关的数据感知组件 } procedure ConnectDataSource;{ 连接数据查询组件和数据感知组件的方法 } protected procedure Execute; override;{ 执行线程的方法 } public constructor Create(Query: TQuery; DataSource: TDataSource); virtual; { 线程构造器 } end; var Form1: TForm1; Q1, { 线程查询对象1 } Q2: TThreadQuery; { 线程查询对象2 } implementation {$R *.DFM} { TThreadQuery类的实现 } { 连接数据查询组件和数据感知组件} procedure TThreadQuery.ConnectDataSource; begin FDataSource.DataSet := FQuery;{ 该方法在查询结束后才调用 } end; procedure TThreadQuery.Execute;{ 执行线程的方法 } begin try FQuery.Open; { 打开查询 } Synchronize(ConnectDataSource);{ 线程同步 } except ShowMessage('Query Error'); { 线程异常 } end; end; { 线程查询类的构造器 } constructor TThreadQuery.Create(Query: TQuery; DataSource: TDataSource); begin FQuery := Query; FDataSource := DataSource; inherited Create(True); FreeOnTerminate := False; end; { 创建窗体时创建线程查询对象 } procedure TForm1.FormCreate(Sender: TObject); begin Q1 := TThreadQuery.Create(Query1, DataSource1); Q2 := TThreadQuery.Create(Query2, DataSource2); end; { 销毁窗体时销毁线程查询对象 } procedure TForm1.FormDestroy(Sender: TObject); begin Q1.Terminate; { 销毁之前终止线程执行 } Q1.Destroy; Q2.Terminate; { 销毁之前终止线程执行 } Q2.Destroy; end; { 开始线程、继续执行线程、挂起线程 } procedure TForm1.BtnGoPauseClick(Sender: TObject); begin if Q1.Suspended then Q1.Resume else Q1.Suspend; if Q2.Suspended then Q2.Resume else Q2.Suspend; end; end.