delphi 调用 QueueUserWorkItem 函数

 QueueUserWorkItem 函数 Windows 说明如下：

 

一、异步调用函数:
BOOL QueueUserWorkItem(
PTHREAD_START_ROUTINE pfnCallback,
PVOID pvContext，
ULONG dwFlags);
该函数将“工作项目”放入线程池并且立即返回。工作项目是指一个用pfnCallback参数标识的函数。它被调用并且传递单个参数pvContext.工作项目函数原型如下：
DWORD WINAPI WorkItemFunc(PVOID pvContext);
dwFlags参数：WT_EXECUTEDEFAULT  工作项目放入非I/O组件得线程中
             WT_EXECUTEINIOTHREAD 工作项目放入I/O组件的线程中，这样的线程在I/O请求没有完成之前不会被终止运行                                  ，防止因为线程被终止导致I/O请求丢失。
             WT_EXECUTEINPERSISTENTTHREAD 放入永久线程池，
             WT_EXECUTELONGFUNCTION  工作项目需要长时间的工作，系统会据此安排更多的线程。

线程池不能设置线程个数的上限，否则排队个数超过线程个数上限的时候，会导致所有的线程都被中断。

工作项目函数如果访问了已经被卸载的DLL,会产生违规访问。

 

delphi 官网给出的调用例子：

unit ThreadPoolUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm3 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    type
      TWorkerColor = class
        FThreadID: Integer;
        FColor: TColor;
        FForm: TForm3;
        procedure PaintLines(Sender: TObject);
        procedure PaintLine;
        constructor Create(AForm: TForm3; AColor: TColor);
      end;
    var
      FIndex: Integer;
  public
    { Public declarations }
  end;

  TObjectHelper = class helper for TObject

  end;

  TThreadPool = class
  private
    type
      TUserWorkItem = class
        FSender: TObject;
        FWorkerEvent: TNotifyEvent;
      end;
    class procedure QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent; Flags: ULONG); overload; static;
  public
    class procedure QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); overload; static;
    class procedure QueueIOWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); static;
    class procedure QueueUIWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent); static;
  end;

var
  Form3: TForm3;
  ThreadPool: TThreadPool;

implementation

{$R *.dfm}

const
  WT_EXECUTEDEFAULT       = ULONG($00000000);
  WT_EXECUTEINIOTHREAD    = ULONG($00000001);
  WT_EXECUTEINUITHREAD    = ULONG($00000002);
  WT_EXECUTEINWAITTHREAD  = ULONG($00000004);
  WT_EXECUTEONLYONCE      = ULONG($00000008);
  WT_EXECUTEINTIMERTHREAD = ULONG($00000020);
  WT_EXECUTELONGFUNCTION  = ULONG($00000010);
  WT_EXECUTEINPERSISTENTIOTHREAD  = ULONG($00000040);
  WT_EXECUTEINPERSISTENTTHREAD = ULONG($00000080);
  WT_TRANSFER_IMPERSONATION = ULONG($00000100);

function QueueUserWorkItem (func: TThreadStartRoutine; Context: Pointer; Flags: ULONG): BOOL; stdcall; external kernel32 name 'QueueUserWorkItem';

function InternalThreadFunction(lpThreadParameter: Pointer): Integer; stdcall;
begin
  Result := 0;
  try
    try
      with TThreadPool.TUserWorkItem(lpThreadParameter) do
        if Assigned(FWorkerEvent) then
          FWorkerEvent(FSender);
    finally
      TThreadPool.TUserWorkItem(lpThreadParameter).Free;
    end;
  except

  end;
end;

{ TThreadPool }

class procedure TThreadPool.QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEDEFAULT);
end;

class procedure TThreadPool.QueueIOWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEINIOTHREAD);
end;

class procedure TThreadPool.QueueUIWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent);
begin
  QueueWorkItem(Sender, WorkerEvent, WT_EXECUTEINUITHREAD);
end;

class procedure TThreadPool.QueueWorkItem(Sender: TObject; WorkerEvent: TNotifyEvent; Flags: ULONG);
var
  WorkItem: TUserWorkItem;
begin
  if Assigned(WorkerEvent) then
  begin
    IsMultiThread := True;
    WorkItem := TUserWorkItem.Create;
    try
      WorkItem.FWorkerEvent := WorkerEvent;
      WorkItem.FSender := Sender;
      if not QueueUserWorkItem(InternalThreadFunction, WorkItem, Flags) then
        RaiseLastOSError;
    except
      WorkItem.Free;
      raise;
    end;
end;
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  FIndex := PaintBox1.Height;
  PaintBox1.Repaint;
  ListBox1.Items.Clear;
  TWorkerColor.Create(Self, clBlue);
  TWorkerColor.Create(Self, clRed);
  TWorkerColor.Create(Self, clYellow);
  TWorkerColor.Create(Self, clLime);
  TWorkerColor.Create(Self, clFuchsia);
  TWorkerColor.Create(Self, clTeal);
end;

{ TForm3.TWorkerColor }

constructor TForm3.TWorkerColor.Create(AForm: TForm3; AColor: TColor);
begin
  FForm := AForm;
  FColor := AColor;
  TThreadPool.QueueWorkItem(Self, PaintLines);
end;

procedure TForm3.TWorkerColor.PaintLines(Sender: TObject);
var
  I: Integer;
begin
  FThreadID := GetCurrentThreadID;
  for I := 0 to 9 do
  begin
    PaintLine;
    //TThread.Synchronize(nil, PaintLine);
    Sleep(100);
  end;
  Destroy;
end;

procedure TForm3.TWorkerColor.PaintLine;
begin
  FForm.PaintBox1.Canvas.Lock;
  try
    FForm.ListBox1.Items.Add(IntToStr(FThreadID));
    with FForm.PaintBox1 do
    begin
      Canvas.Pen.Color := FColor;
      Canvas.Polyline([Point(0, FForm.FIndex), Point(Width, FForm.FIndex)]);
      Dec(FForm.FIndex);
      if FForm.FIndex <= 0 then
        FForm.FIndex := 0;
    end;
  finally
    FForm.PaintBox1.Canvas.Unlock;
  end;
end;

end.

调用搞得太复杂，得弄一个简单的

转载于:https://www.cnblogs.com/MLKJ/archive/2010/11/30/1892433.html