再用 SyncObJS 單元下的 TSemaphore 類實現一次, 使用方法差不多, 運行效果也一樣:unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses SyncObJS;
var
f: Integer;
MySemaphore: TSemaphore;
function MyThreadFun(p: Pointer): DWord; stdcall;
var
i,y: Integer;
begin
Inc(f);
y := 20 * f;
if MySemaphore.WaitFor(INFINITE) = wrSignaled then
begin
for i := 0 to 1000 do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(20, y, IntToStr(i));
Form1.Canvas.Unlock;
Sleep(1);
end;
end;
MySemaphore.Release;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadID: DWord;
begin
if Assigned(MySemaphore) then MySemaphore.Free;
MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, '');
Self.Repaint;
f := 0;
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;
{讓 Edit 只接受 1 2 3 4 5 五個數}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not CharInSet(Key, ['1'..'5']) then Key := #0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := '1';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(MySemaphore) then MySemaphore.Free;
end;
end.
