线程！线程！！线程！！！(Delphi版)

一、

以下内容仅供初学者参考

看到有的同学对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