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

以下内容仅供初学者参考

看到有的同学对Delphi的线程认识不够深，特开一贴给同学们讲讲。

主要给出两种常用的线程形式。

1、长等待型线程示例，等待命令，执行不定长的工作，但每个工作的时间不会太长。
2、长工作型线程示例，执行一个很长时间的工作，但可以很快响应取消操作。

注：对于在线程中取消存储过程的执行仍然无解

以下程序所用的知识为:消息机制以及常用的API函数


主程序Unit1

Delphi(Pascal) code

   
   

    
    
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
    
    .