delphi 线程实战用法

时间：2015-09-05 09:52:41 阅读：626 评论：0 收藏：0 [点我收藏+]

标签：

新版delphi，带有匿名函数功能，大大方便了使用者。

现使用匿名函数开发一个方便实用的线程类，简化线程调用。

1. uSyncObjs.pas,TSuperEvent对TEvent的改进

2. uThreadTList, 对TList的改进

3. uSuperThreadCommon.pas,公共类,继承TThreadList,带自动释放

4. uSuperThreadHelper.pas, 由TThread线程继承而来,一个方便的单独线程类,平时用它可以快速实现线程功能。

5. uSuperThreadWorker.pas, 继承于TSuperThreadHelper,也是TSuperThreadHelper线程的典型应用。

6. uSuperThread.pas ，对TSuperThreadHelper 的包装

本代码在delphi xe8 下编译通过，个人认为在xe2及以上版本都应能正常使用。

使用方法

TSuperThread 有两个函数:Queue,Synchronize

Queue:把匿名函数排队到线程去执行,马上返回。

Synchronize:把匿名函数排队到线程，并等待此函数执行完毕。

虽说TThread本身自带这两个函数。但是，它是把匿名函数插到主线程去执行的。

本类是将匿名函数插入到一个线程中执行的，有本质上的区别。

SuperThread:=TSuperThread.Create; //在合适的时候创建


//排队执行
SuperThread.Queue( procedrue 
                              begin
                                 DoWhatYouWant; 
                                 Sleep(5000); //
                               end; );
//阻塞执行
SuperThread.Synchronize( procedrue 
                              begin
                                 DoWhatYouWant; 
                                 Sleep(5000); //
                               end; );




SuperThread.free; //在合适的时候释放

以下是源代码，欢迎交流。

unit uSyncObjs;

interface

uses
  SyncObjs;

Type

  TSuperEvent = class(TEvent)
  public
    constructor Create; reintroduce;
  end;

implementation

{ TSuperEvent }
uses
  SysUtils;

constructor TSuperEvent.Create;
var
  BGUID: TGUID;
begin
  CreateGUID(BGUID);
  inherited Create(nil, true, false, GUIDToString(BGUID));
end;

end.

unit uThreadList;

interface

uses
  Generics.Collections;

type

  TThreadListX<T> = class(TList<T>)
  private
    function DoPopByIndex(Index: integer): T;
    procedure FreeAllItem;
  protected
    FNeedFreeItem: boolean;
    procedure FreeItem(Item: T); virtual;
  public

    constructor Create;
    destructor Destroy; override;

    procedure Lock;
    procedure Unlock;

    function PopFirst: T;
    function PopLast: T;
    function PopByIndex(Index: integer): T;

    procedure ClearAndFreeItem;

  end;

  TThreadClassList<T: Class> = class(TThreadListX<T>)
  protected
    procedure FreeItem(Item: T); override;
  end;


implementation

procedure TThreadListX<T>.ClearAndFreeItem;
begin
  FreeAllItem;
  clear;
end;

constructor TThreadListX<T>.Create;
begin
  inherited;
  FNeedFreeItem := true;
end;

destructor TThreadListX<T>.Destroy;
begin
  FreeAllItem;
  inherited;
end;

function TThreadListX<T>.DoPopByIndex(Index: integer): T;
begin
  if (index >= 0) and (index <= count - 1) then
  begin
    result := items[index];
    delete(index);
    Exit;
  end;
  result := T(nil);
end;

procedure TThreadListX<T>.FreeAllItem;
var
  Item: T;
begin
  if FNeedFreeItem then
  begin
    for Item in self do
      FreeItem(Item);
  end;
end;

procedure TThreadListX<T>.FreeItem(Item: T);
begin
end;

procedure TThreadListX<T>.Lock;
begin
  System.TMonitor.Enter(self);
end;

procedure TThreadListX<T>.Unlock;
begin
  System.TMonitor.Exit(self);
end;

function TThreadListX<T>.PopByIndex(Index: integer): T;
begin
  result := DoPopByIndex(index);
end;

function TThreadListX<T>.PopFirst: T;
begin
  result := DoPopByIndex(0);
end;

function TThreadListX<T>.PopLast: T;
begin
  result := DoPopByIndex(count - 1);
end;

{ TThreadClassList<T> }

procedure TThreadClassList<T>.FreeItem(Item: T);
begin
  TObject(Item).Free;
end;

end.


unit uSuperThreadCommon;

interface

uses
  Classes, uThreadList, uSyncObjs;

type

  PSyncRec = ^TSyncRec;

  TSyncRec = record
    FMethod: TThreadMethod;
    FProcedure: TThreadProcedure;
    FSignal: TSuperEvent;
    Queued: boolean;
  end;

  TSyncRecList = Class(TThreadListX<PSyncRec>)
  protected
    procedure FreeItem(Item: PSyncRec); override;
  End;

implementation

{ TSyncRecList }

procedure TSyncRecList.FreeItem(Item: PSyncRec);
begin
  if Assigned(Item.FSignal) then
    Item.FSignal.Free;
  dispose(Item);
end;

end.

unit uSuperThreadHelper;

interface

uses
  System.Classes, System.SysUtils, System.SyncObjs;

type

  TSuperThreadHelper = class(TThread)
  public type

    TObjectProc = TThreadMethod;
    TAnonymousProc = TThreadProcedure;

  private type
    TProcKind = (pkObject, pkAnonymous);
  private

    FObjProc: TObjectProc;
    FAnoProc: TAnonymousProc;
    FProcKind: TProcKind;

    FEvent: TEvent;

    procedure SelfStart;

    procedure DoExecute;

  protected

    FWaitStop: boolean;

    procedure Execute; override;

    procedure OnThreadProcErr(E: Exception); virtual;

  public

    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure WaitThreadStop;

    procedure ExeProcInThread(AProc: TObjectProc); overload;
    procedure ExeProcInThread(AProc: TAnonymousProc); overload;

    procedure StopThread;
    property WaitStop: boolean read FWaitStop;

  end;

implementation

constructor TSuperThreadHelper.Create;
var
  BGUID: TGUID;
begin
  inherited Create(false);
  FreeOnTerminate := false;
  CreateGUID(BGUID);
  FEvent := TEvent.Create(nil, true, false, GUIDToString(BGUID));

end;

destructor TSuperThreadHelper.Destroy;
begin
  WaitThreadStop;
  FEvent.Free;
  inherited;
end;

procedure TSuperThreadHelper.DoExecute;
begin
  repeat

    FEvent.WaitFor;
    FEvent.ResetEvent; // 下次waitfor 一直等

    if not Terminated then
    begin

      try

        case FProcKind of
          pkObject: FObjProc;
          pkAnonymous: FAnoProc;
        end;

      except

        on E: Exception do
        begin
          OnThreadProcErr(E);
        end;

      end;

    end;

  until Terminated;
end;

procedure TSuperThreadHelper.Execute;
begin
  DoExecute;
end;

procedure TSuperThreadHelper.ExeProcInThread(AProc: TObjectProc);
begin
  FObjProc := AProc;
  FProcKind := pkObject;
  SelfStart;
end;

procedure TSuperThreadHelper.ExeProcInThread(AProc: TAnonymousProc);
begin
  FAnoProc := AProc;
  FProcKind := pkAnonymous;
  SelfStart;
end;

procedure TSuperThreadHelper.OnThreadProcErr(E: Exception);
begin;
end;

procedure TSuperThreadHelper.SelfStart;
begin
  if FEvent.WaitFor(0) <> wrSignaled then
    FEvent.SetEvent; // 让waitfor 不再等
end;

procedure TSuperThreadHelper.StopThread;
begin
  FWaitStop := true;
end;

procedure TSuperThreadHelper.WaitThreadStop;
begin
  StopThread;
  Terminate;
  SelfStart;
  WaitFor;
end;

end.

unit uSuperThreadWorker;

interface

uses
  classes, uSuperThreadHelper, uSuperThreadCommon;

type

  TSuperThreadWorker = class(TSuperThreadHelper)
  private
    FSyncRecList: TSyncRecList;

    procedure lock;
    procedure Unlock;

    procedure Check;
    procedure DoCheck;

    procedure SetSyncRecList(const Value: TSyncRecList);

  public

    property SyncRecList: TSyncRecList read FSyncRecList write SetSyncRecList;

    procedure Queue(AMethod: TThreadMethod); overload;
    procedure Queue(AProcedure: TThreadProcedure); overload;

    procedure Synchronize(AMethod: TThreadMethod); overload;
    procedure Synchronize(AProcedure: TThreadProcedure); overload;

    constructor Create;
    destructor Destroy; override;

  end;

implementation

{ TSuperThreadInspector }
uses
  uSyncObjs;

procedure TSuperThreadWorker.Check;
begin
  ExeProcInThread(DoCheck);
end;

constructor TSuperThreadWorker.Create;
begin
  inherited;
  FSyncRecList := TSyncRecList.Create;
end;

destructor TSuperThreadWorker.Destroy;
begin
  WaitThreadStop;
  FSyncRecList.Free;
  inherited;
end;

procedure TSuperThreadWorker.DoCheck;
var
  p: PSyncRec;
begin

  lock;
  try
    p := FSyncRecList.PopFirst;
  finally
    Unlock;
  end;

  if Assigned(p) then
  begin

    if Assigned(p.FMethod) then
      p.FMethod
    else if Assigned(p.FProcedure) then
      p.FProcedure();

    if not p.Queued then
    begin
      p.FSignal.SetEvent;
    end;

    Dispose(p);
    Check;

  end;

end;

procedure TSuperThreadWorker.lock;
begin
  FSyncRecList.lock;
end;

procedure TSuperThreadWorker.Queue(AMethod: TThreadMethod);
var
  p: PSyncRec;
begin
  new(p);

  p.FProcedure := nil;
  p.FMethod := AMethod;
  p.Queued := true;

  lock;
  try
    FSyncRecList.Add(p);
    Check;
  finally
    Unlock;
  end;

end;

procedure TSuperThreadWorker.Queue(AProcedure: TThreadProcedure);
var
  p: PSyncRec;
begin
  new(p);
  p.FProcedure := AProcedure;
  p.FMethod := nil;
  p.Queued := true;
  lock;
  try
    FSyncRecList.Add(p);
    Check;
  finally
    Unlock;
  end;
end;

procedure TSuperThreadWorker.SetSyncRecList(const Value: TSyncRecList);
begin
  FSyncRecList := Value;
end;

procedure TSuperThreadWorker.Synchronize(AMethod: TThreadMethod);
var
  p: PSyncRec;
  o: TSuperEvent;
begin
  new(p);

  p.FProcedure := nil;
  p.FMethod := AMethod;
  p.Queued := false;
  p.FSignal := TSuperEvent.Create;
  p.FSignal.ResetEvent;
  o := p.FSignal;

  lock;
  try
    FSyncRecList.Add(p);
    Check;
  finally
    Unlock;
  end;

  o.WaitFor;
  o.Free;

end;

procedure TSuperThreadWorker.Synchronize(AProcedure: TThreadProcedure);
var
  p: PSyncRec;
  o: TSuperEvent;
begin
  new(p);

  p.FProcedure := AProcedure;
  p.FMethod := nil;
  p.Queued := false;
  p.FSignal := TSuperEvent.Create;
  p.FSignal.ResetEvent;
  o := p.FSignal;

  lock;
  try
    FSyncRecList.Add(p);
    Check;
  finally
    Unlock;
  end;

  o.WaitFor;
  o.Free;

end;

procedure TSuperThreadWorker.Unlock;
begin
  FSyncRecList.Unlock;
end;

end.

unit uSuperThread;

interface

uses
  Classes, uSuperThreadWorker;

type

  TSuperThread = class
  private
    FSuperThreadWorker: TSuperThreadWorker;
  public

    constructor Create;
    destructor Destroy; override;

    procedure Queue(AMethod: TThreadMethod); overload;
    procedure Queue(AProcedure: TThreadProcedure); overload;

    procedure Synchronize(AMethod: TThreadMethod); overload;
    procedure Synchronize(AProcedure: TThreadProcedure); overload;

  end;

implementation

{ TSuperThread }

constructor TSuperThread.Create;
begin
  inherited;
  FSuperThreadWorker := TSuperThreadWorker.Create;
end;

destructor TSuperThread.Destroy;
begin
  FSuperThreadWorker.WaitThreadStop;
  FSuperThreadWorker.Free;
  inherited;
end;

procedure TSuperThread.Queue(AMethod: TThreadMethod);
begin
  FSuperThreadWorker.Queue(AMethod);
end;

procedure TSuperThread.Queue(AProcedure: TThreadProcedure);
begin
  FSuperThreadWorker.Queue(AProcedure);
end;

procedure TSuperThread.Synchronize(AMethod: TThreadMethod);
begin
  FSuperThreadWorker.Synchronize(AMethod);
end;

procedure TSuperThread.Synchronize(AProcedure: TThreadProcedure);
begin
  FSuperThreadWorker.Synchronize(AProcedure);
end;

end.

delphi 线程实战用法

标签：

原文地址：http://www.cnblogs.com/lackey/p/4782777.html

踩

(0)

评论一句话评论（0）

分享档案

更多>

2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)

周排行