一、
以下内容仅供初学者参考
看到有的同学对Delphi的线程认识不够深,特开一贴给同学们讲讲。
主要给出两种常用的线程形式。
1、长等待型线程示例,等待命令,执行不定长的工作,但每个工作的时间不会太长。
2、长工作型线程示例,执行一个很长时间的工作,但可以很快响应取消操作。
注:对于在线程中取消存储过程的执行仍然无解
以下程序所用的知识为:消息机制以及常用的API函数
主程序Unit1
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.
线程类:
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.
---------------------------------------------------------------------------------------------------
delphi query 查詢線程。。。
下面的例子给出了同时进行的两个线程查询。第一次按下按钮时,线程开始执行;以后每次按下按钮时,如果线程处于挂起状态则继续执行,否则挂起线程;线程执行完毕之后将连接 DataSource,查询结果将显示在相应的DBGrid中。
{ 这里的多线程同步查询演示程序仅包括一个工程文件和一个单元文件 }
{ 窗体中放置的组件有: }
{ 两个Session组件 }
{ 两个Database组件 }
{ 两个Query组件 }
{ 两个DataSource组件 }
{ 两个DBGrid组件 }
{ 一个Button组件 }
{ 除非特别说明,否则上述各组件的属性都取默认值(见各组件注释) }
{ 对于Database组件,就和一般设置一样,有一个正确的连接即可 }
{ 对于Query 组件,需要在各自的属性 SQL中添加一些查询语句,为了 }
{ 看得更清除,建议不要在两个Query 组件中填写相同的查询语句。 }
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.
原链接:http://topic.csdn.net/u/20110217/11/56577c65-2e77-4f8f-b541-0be47cdb4d60.html?6620