delphi 多线程（API实现）  
官方Delphi 学习QQ群： 682628230（三千人）
频道

  1. 人气：
  2. 放大
  3. 缩小
  4. 二维码
  5. 赞赏

delphi 多线程（API实现）

首先看下构造函数：（会自动销毁）

function CreateThread(

  lpThreadAttributes: Pointer;           {安全设置}   {一般为Nil}

  dwStackSize: DWORD;                    {堆栈大小} {0为默认大小}

  lpStartAddress: TFNThreadStartRoutine; {入口函数} { 例：@MyFun}

  lpParameter: Pointer;                  {函数参数}｛入口函数的参数｝{@参数}

  dwCreationFlags: DWORD;                {启动选项}  {有两个值，0时立即执行入口函数，CREATE_SUSPENDED，挂起等待。可用 ResumeThread（句柄） 函数是恢复线程的运行; 可用 SuspendThread（句柄） 再次挂起线程.}

  var lpThreadId: DWORD                  {输出线程 ID } {输入你的接收句柄变量}

): THandle; stdcall;                     {返回线程句柄}

例子：
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function MyFun(p:Pointer):integer;stdcall; {工作线程调入函数，stdcall用于多个线程排序以及系统级别调用加此关键字}
var
  i:integer;
begin
  for i := 0 to 500000 do    
  begin
    with Form1.Canvas do
    begin
      Lock;
      TextOut(50,10,IntToStr(i)); {50和10是坐标X和Y}
      Unlock;
      Application.ProcessMessages;
    end;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);{主线程}
var
  i:integer;
begin
  for i := 0 to 500000 do  
  begin
    with Form1.Canvas do
    begin
      Lock;
      TextOut(10,10,IntToStr(i)); {10和10是坐标X和Y}
      Unlock;
      Application.ProcessMessages;{加上去才在计数时不会卡住，拖动窗体时，计数会有停顿}
    end;
  end;

end;

procedure TForm1.btn2Click(Sender: TObject);{工作线程，拖动窗口时计数不会停顿，因为和主线程分开工作了}
var
  ID:THandle; {用于接收线程返回句柄，也可以用DWORD}
begin
  CreateThread(nil,0,@MyFun,nil,0,ID);  {API创建线程}
end;

end.

CriticalSection(临界区)：
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    lst1: TListBox;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  CS:TRTLCriticalSection; {声明临界}

function MyFun(p:Pointer):integer;stdcall;
var
  i:integer;
begin
  EnterCriticalSection(CS);  {我要用了，别人先别用}
  for i := 0 to 100 - 1 do
  begin
    Form1.lst1.Items.Add(IntToStr(i));
  end;
  LeaveCriticalSection(CS);  {我用完了，别可以用了}

end;

procedure TForm1.btn1Click(Sender: TObject);
var
  ID:THandle;
begin
  InitializeCriticalSection(CS); {初始化临界}
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(CS);  {删除临界}
end;

end.

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

先说明等待函数(后面要配套使用)：

function WaitForSingleObject(
hHandle: THandle; {要等待的对象句柄}
dwMilliseconds: DWORD {等待的时间, 单位是毫秒}
): DWORD; stdcall; {返回值如下:}

WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}
WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}

//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Mutex (互斥对象)

要理解的函数有：

function CreateMutex(
lpMutexAttributes: PSecurityAttributes; {安全参数，默认真nil}
bInitialOwner: BOOL; {是否让创建者(此例中是主线程)拥有该互斥对象}{一般为False}
lpName: PWideChar {可以给此互斥对象取个名字, 如果不要名字可赋值为 nil}
): THandle;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hMutex:THandle; {声明互斥变量句柄}
  f:Integer;      {用于协调输出位置的变量}

function MyFun(p:Pointer):Integer;stdcall;
var
  i,y:integer;
begin
  Inc(f);  {步进f}
  y:=20*f;
  if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then   {等待函数}
  begin
    for i := 0 to 500 do
    begin
      with Form1.Canvas do
      begin
        Lock;
        TextOut(10,Y,IntToStr(i));
        Unlock;
        sleep(1); {太快怕忙不过来}
      end;
    end;
    ReleaseMutex(hMutex);
  end;
end;  


procedure TForm1.btn1Click(Sender: TObject);
var
  ID:THandle;
begin
  f:=0; {初始化f为0}
  Repaint; {重画}
  CloseHandle(hMutex); {先关闭句柄}
  hMutex:=CreateMutex(nil,False,nil);  {创建互斥体}
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hMutex);  {关闭句柄}
end;

end.

Semaphore(信号或叫信号量)

要理解的函数：

CreateSemaphore(安全设置, 初始信号数, 信号总数, 信号名称) 建立信号对象;
参数四: 和 Mutex 一样, 它可以有个名称, 也可以没有, 本例就没有要名称(nil); 有名称的一般用于跨进程.
参数三: 信号总数, 是 Semaphore 最大处理能力, 就像银行一共有多少个业务窗口一样; 
参数二: 初始信号数, 这就像银行的业务窗口很多, 但打开了几个可不一定, 如果没打开和没有一样;{本例用个EDIT输入数量，每次释放后又进行同样数量}
参数一: 安全设置和前面一样, 使用默认(nil)即可.

ReleaseSemaphore(接受信号量句柄,1[接收多少个信号] , nil[一般为空，如果是指针可以接受到此时共闲置了多少个信号量])；

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    edt1: TEdit;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hsmaphore:THandle; {信号量句柄}
  f:Integer;         {协调输出的变量}

function MyFun(p:Pointer):integer;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;
  if WaitForSingleObject(hsmaphore,INFINITE)=WAIT_OBJECT_0 then
  begin
    for i := 0 to 500 do
    begin
      with Form1,Canvas do
      begin
        Lock;
        TextOut(10,y,IntToStr(i));
        Unlock;
        Sleep(1);
      end;
    end;
    ReleaseSemaphore(hsmaphore,1,nil); {释放函数}
  end;
  Result:=0;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  ID:DWORD;
begin
  CloseHandle(hsmaphore);  {先关闭句柄}
  hsmaphore:=CreateSemaphore(nil,StrToInt(edt1.Text),5,nil); {创建句柄}
  CreateThread(nil,0,@MyFun,nil,0,ID);   {创建线程}
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

procedure TForm1.btn1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['1'..'5']) then Key:=#0;  {设置只能输入1到5，并且在控件属性设置宽度为1}
  
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hsmaphore);  {关闭句柄}
end;

end.

Event (事件对象)

function CreateEvent(
lpEventAttributes: PSecurityAttributes; {安全设置}
bManualReset: BOOL; {第一个布尔}
bInitialState: BOOL; {第二个布尔}
lpName: PWideChar {对象名称}
): THandle; stdcall; {返回对象句柄}

//第一个布尔为 False 时, 事件对象控制一次后将立即重置(暂停); 为 True 时可手动暂停.
//第二个布尔为 False 时, 对象建立后控制为暂停状态; True 是可运行状态.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hEvent:THandle;
  f:integer;

function MyFun (p:Pointer):Integer;
var
  i,y:integer;
begin
  Inc(f);
  y:=20*f;
  for i := 0 to 200000 do
  begin
    if WaitForSingleObject(hEvent,INFINITE)=WAIT_OBJECT_0 then
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(10,y,IntToStr(i));
      Form1.Canvas.Unlock;
      
    end;
  end;
  Result:=0;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  ID:DWORD;
begin
  Repaint;  {重画}
  f:=0;
  CloseHandle(hEvent);{先关闭线程}
  hEvent:=CreateEvent(nil,True,True,nil)  {创建事件}
end;

procedure TForm1.btn2Click(Sender: TObject);
var
  ID:DWORD;
begin
  CreateThread(nil,0,@MyFun,nil,0,ID);  {创建线程}

end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  ResetEvent(hEvent); {暂停,可对当前所有事件相关线程暂停}
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  SetEvent(hEvent);  {启动，可对当前所有事件相关线程启动}
end;

procedure TForm1.btn5Click(Sender: TObject);
begin
  PulseEvent(hEvent); {启动一次再暂停，可对当前所有事件相关线程}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  btn1.Caption := '创建 Event 对象';
  btn2.Caption := '创建线程';
  btn3.Caption := 'ResetEvent';
  btn4.Caption := 'SetEvent';
  btn5.Caption := 'PulseEvent';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hEvent); {关闭事件句柄}
end;

end.

等待记时器对象：WaitableTimer{比较复杂，可不记，需要使用时查阅}

{它的主要功用类似 TTimer 类,既然有了方便的 TTimer, 何必再使用 WaitableTimer 呢?
因为 WaitableTimer 比 TTimer 精确的多, 它的间隔时间可以精确到毫秒、它的指定时间甚至是精确到 0.1 毫秒;
而 TTimer 驱动的 WM_TIMER 消息, 是消息队列中优先级最低的, 也就是再同一时刻 WM_TIMER 消息总是被最后处理.
还有重要的一点 WaitableTimer 可以跨线程、跨进程使用.}

需要了解的函数：

function CreateWaitableTimer(
lpTimerAttributes: PSecurityAttributes; {安全}
bManualReset: BOOL; {True: 可调度多个线程; False: 只调度一个线程}
lpTimerName: PWideChar {名称}
): THandle; stdcall; {返回句柄}

function SetWaitableTimer(
hTimer: THandle; {句柄} {WaitableTimer 对象的句柄}
var lpDueTime: TLargeInteger; {起始时间} //0为马上，另有相对时间如:-3*10000000; {3秒钟后执行}，绝对时间：如：'2016-08-26 10:06:00' 需要转换
lPeriod: Longint; {间隔时间}
pfnCompletionRoutine: TFNTimerAPCRoutine;{回调函数的指针，不用时为空} 
lpArgToCompletionRoutine: Pointer; {给回调函数的参数，不用时为空}
fResume: BOOL {是否唤醒系统}{此值若是 True, 即使系统在屏保或待机状态, 时间一到线程和系统将都被唤醒!}
): BOOL; stdcall; {}

 

例1：指定多少秒后运行(相对时间)：

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hWaitableTimer:THandle;
  f:integer;

function MyFun(p:Pointer):integer;
var
  i,y:integer;
begin
  inc(f);
  y:=20*f;

  if WaitForSingleObject(hWaitableTimer,INFINITE)=WAIT_OBJECT_0 then
  begin
    for I := 0 to 1000 do
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(10,Y,IntToStr(I));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;
  end;
  Result:=0;
end;



procedure TForm1.btn1Click(Sender: TObject);
var
  DueTimer:Int64;
  ID:DWORD;
begin
  hWaitableTimer:=CreateWaitableTimer(nil,True,nil); {创建等待计时器，允许多线程同时进行}
  DueTimer:=-3*10000000; {三秒后执行}
  SetWaitableTimer(hWaitableTimer,DueTimer,0,nil,nil,False);  {设置计时器开始运行时间}

  Repaint;
  f:=0;
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hWaitableTimer); {句柄}
end;

end.

例2：指定一个时间里运行(绝对时间)：

//StrToDateTime -> DateTimeToSystemTime -> SystemTimeToFileTime -> LocalFileTimeToFileTime 时间转换

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hWaitableTimer:THandle;
  f:integer;

function MyFun(p:Pointer):integer;
var
  i,y:integer;
begin
  inc(f);
  y:=20*f;

  if WaitForSingleObject(hWaitableTimer,INFINITE)=WAIT_OBJECT_0 then
  begin
    for I := 0 to 1000 do
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(10,Y,IntToStr(I));
      Form1.Canvas.Unlock;
      Sleep(1);
    end;
  end;
  Result:=0;
end;



procedure TForm1.btn1Click(Sender: TObject);
const
  strTime='2016-8-29 14:41:30';
var
  DueTimer:Int64;
  ID:DWORD;
  st:TSystemTime;
  ft,Utc:TFileTime;
  dt:TDateTime;
begin
  DateTimeToSystemTime(StrToDateTime(strTime), st); {从 TDateTime 到 TSystemTime}
  SystemTimeToFileTime(st, ft);                     {从 TSystemTime 到 TFileTime}
  LocalFileTimeToFileTime(ft, UTC);                 {从本地时间到国际标准时间 UTC}
  DueTimer:= Int64(UTC);                            {函数需要的是 Int64}

  hWaitableTimer:=CreateWaitableTimer(nil,True,nil); {创建等待计时器，允许多线程同时进行}
  SetWaitableTimer(hWaitableTimer,DueTimer,0,nil,nil,False);  {设置计时器开始运行时间}

  Repaint;
  f:=0;
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hWaitableTimer); {关闭句柄}
end;

end.

下面例子需要了解以下函数：

function SleepEx(
dwMilliseconds: DWORD; {毫秒数} {INFINITE 表示一直等}
bAlertable: BOOL {布尔值}
): DWORD; stdcall;

//第一个参数和 Sleep 的那个参数是一样的, 是线程等待(或叫挂起)的时间, 时间一到不管后面参数如何都会返回.

//第二个参数如果是 False, SleepEx 将不会关照 APC 函数是否入列;
//若是 True, 只要有 APC 函数申请, SleepEx 不管第一个参数如何都会把 APC 推入队列并随 APC 函数一起返回.

//注意: SetWaitableTimer 和 SleepEx 必须在同一个线程才可以.

procedure TimerAPCProc(lpArgToCompletionRoutine: Pointer;dwTimerLowValue: DWORD;dwTimerHighValue: DWORD); stdcall;
//系统定义给SetWaitableTimer第一个回调函数指针的格式函数｛名字可以变，格式和类型不能变。｝

 

例3：窗口标题自增数字

本例在SetWaitableTimer使用TimerAPCProc回调函数，但不使用回调函数的参数

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hTimer:THandle;

procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
begin
  Form1.Text:=IntToStr(StrToIntDef(Form1.Text,0)+1);
  SleepEx(INFINITE,True);     {在回调参数里加这一句，会不断的循环}
end;

function MyFun(p:Pointer):integer;stdcall;
var
  DueTime:Int64;
begin
  DueTime:=0;
  {SetWaitableTimer 必须与 SleepEx 在同一线程}
  if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,nil,False) then  //使用了APC回调函数，回调函数的参数此例没有
  begin
    SleepEx(INFINITE,True);
  end;
  Result:=0;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  ID:DWORD;
begin
  CloseHandle(hTimer);
  hTimer:=CreateWaitableTimer(nil,True,nil); {建立定时器}
  CreateThread(nil,0,@MyFun,nil,0,ID);    {创建线程}
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  CancelWaitableTimer(hTimer);{取消定时器}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hTimer);  {关闭句柄}
end;

end.

例4：在窗口标题上显示时间并自增计时

本例利用APC回调参数的第二个，第三个参数值获得时间并转换输出

//参数高低位时间>>合并成TFileTime(世界标准计时)>>LocalFileTime本地时间>>SystemTime系统时间>>Datetime
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hTimer:THandle;

procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
var
  UTCFileTime,LocalFileTime:TFileTime;
  SystemTime:TSystemTime;
  DateTime:TDateTime;
begin
   {把 dwTimerLowValue 与 dwTimerHighValue 和并为一个 TFileTime 格式的时间}
  UTCFileTime.dwLowDateTime := dwTimerLowValue;
  UTCFileTime.dwHighDateTime := dwTimerHighValue;

  FileTimeToLocalFileTime(UTCFileTime, LocalFileTime); {从世界标准计时到本地时间}
  FileTimeToSystemTime(LocalFileTime, SystemTime);     {转到系统格式时间}
  DateTime := SystemTimeToDateTime(SystemTime);        {再转到 TDateTime}

  Form1.Text:=DateTimeToStr(DateTime);
  SleepEx(INFINITE,True);     {在回调参数里加这一句，会不断的循环}
end;

function MyFun(p:Pointer):integer;stdcall;
var
  DueTime:Int64;
begin
  DueTime:=0;
  {SetWaitableTimer 必须与 SleepEx 在同一线程}
  if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,nil,False) then  //使用了APC回调函数
  begin
    SleepEx(INFINITE,True);
  end;
  Result:=0;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  ID:DWORD;
begin
  CloseHandle(hTimer);
  hTimer:=CreateWaitableTimer(nil,True,nil); {建立定时器}
  CreateThread(nil,0,@MyFun,nil,0,ID);    {创建线程}
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  CancelWaitableTimer(hTimer);{取消定时器}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hTimer);  {关闭句柄}
end;

end.
例5：根据鼠标移动事件得到坐票在窗体上出现若干个时间计时

本例利用APC回调参数的第一个指针传递坐标

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hTimer:THandle; {等待计时器句柄}
  pt:TPoint;      {用来传递坐标}

procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
var
  UTCFileTime,LocalFileTime:TFileTime;
  SystemTime:TSystemTime;
  DateTime:TDateTime;
  pt2:TPoint;
begin
   {把 dwTimerLowValue 与 dwTimerHighValue 和并为一个 TFileTime 格式的时间}
  UTCFileTime.dwLowDateTime := dwTimerLowValue;
  UTCFileTime.dwHighDateTime := dwTimerHighValue;

  FileTimeToLocalFileTime(UTCFileTime, LocalFileTime); {从世界标准计时到本地时间}
  FileTimeToSystemTime(LocalFileTime, SystemTime);     {转到系统格式时间}
  DateTime := SystemTimeToDateTime(SystemTime);        {再转到 TDateTime}

  pt2:=PPoint(APointer)^; {接受第一个指针参数坐标 }
  Form1.Canvas.Lock;
  Form1.Canvas.TextOut(pt2.x,pt2.Y,DateTimeToStr(DateTime)); {取XY为坐标}
  Form1.Canvas.Unlock;

  SleepEx(INFINITE,True);  {此句可做循环}
end;

function MyFun(p:Pointer):integer;stdcall;
var
  DueTime:Int64;
begin
  DueTime:=0;
  {SetWaitableTimer 必须与 SleepEx 在同一线程}
  if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,@pt,False) then  //使用了APC回调函数
  begin
    SleepEx(INFINITE,True);  {此句用做循环}
  end;
  Result:=0;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hTimer);  {关闭句柄}
end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ID:DWORD;
begin
  pt:=Point(x,y); {把XY坐票给pt}
  if hTimer = 0 then hTimer:=CreateWaitableTimer(nil,True,nil);
  CreateThread(nil,0,@MyFun,nil,0,ID);
end;

end.

总结：

1.主线程做类似循环输出占用资源会容易卡住，使用Application.ProcessMessages虽然可以解决卡顿，可是却会让循环停下。

2.当需要用多线程安排时，就要用到临界，互斥，信号量，事件，等待计时器（较复杂），以下根据需求作说明：

   临界：多个线程，一个一个进，用完一个再继续下一个。

   互斥：接力棒，谁拿到是谁的。(看等待函数放哪和释放语句放哪，可多个抢着进行，也可一个个运行。)

   信号量：可设置线程总数和先运行的数量。

   事件：可对事件相关的线程进行暂停，开始，步进后暂停。

   等待计时器：可根据需要设定为马上（0），相对时间，绝对时间运行；另外APC队伍调度级别高，时间精确度也比TTimer高。

https://www.cnblogs.com/chaosc/p/5817216.html

推荐分享
最新信息 delphi13 多线程优化 TThreade... delphi 如何 FastMM配置 delphi13 FireDAC增强 并行备份... delphi12 Embarcadero ld... delphi 查看 cpu 核心数
热门信息 delphi 动态数组的使用 delphi多线程TThread详解 delphi try except语句 和 try finally语... delphi中常用字符串处理函数 delphi Inc函数和Dec函数的用法
推荐区 txt文本处理 查询128 说一段 简搜 短笑话 IP查询 正则大全 在线加密解密工具 在线文本筛选工具 1234828网址导航 windows库
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
  1. 关于我们
  2. 联系我们
 

Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号

执行时间: 0.073828935623169 seconds