semaphorefrm.pas

来自「《delphi深度编程及其项目开发》」· PAS 代码 · 共 121 行

PAS
121
字号
unit SemaphoreFrm;

interface

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

type
  //定义一个线程类
  TsyncThread = class(TThread)
  protected
    procedure execute; override;
  end;

  TfrmSemaphore = class(TForm)
    ListBox1: TListBox;
    btnExecute: TButton;
    ListBox2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure btnExecuteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    //定义线程实例变量
    Thread1, Thread2: TSyncThread;
    //自定义过程,在线程结束时调用
    procedure Thread1Done(sender: TObject);
    procedure Thread2Done(sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  MaxSize = 100;
var
  frmsemaphore: Tfrmsemaphore;
  //数据全局区
  GlobalData: array[1..MaxSize] of integer;
  IncNum: Integer = 0;
 //定义信号量对象句柄
  HSem: THandle = 0;
implementation

{$R *.dfm}

//线程执行主体

procedure TSyncThread.execute;
var
  i: integer;
  WaitReturn: DWORD;
begin
  FreeOnTerminate := True;
  //  //进入同步,防止其他线程访问
  WaitReturn := WaitForSingleObject(HSem, INFINITE);
  if WaitReturn = Wait_Object_0 then
    for i := 1 to Maxsize do
    begin
      Inc(IncNum);
      GlobalData[i] := IncNum;
      sleep(5);
    end;
end;

//在窗体创建时,创建信号量

procedure TfrmSemaphore.FormCreate(Sender: TObject);
begin
  HSem := CreateSemaphore(nil, 1, 1, nil);
end;

//在窗体释放时,释放信号量

procedure TfrmSemaphore.FormDestroy(Sender: TObject);
begin
  CloseHandle(HSem);
end;

//创建线程实例

procedure Tfrmsemaphore.btnExecuteClick(Sender: TObject);
begin
  Thread1 := TSyncThread.Create(false);
  Thread1.OnTerminate := Thread1Done;
  Thread2 := TSyncThread.Create(false);
  Thread2.OnTerminate := Thread2Done;
end;

//当线程1执行完后,将GlobalData数据显示出来

procedure TfrmSemaphore.Thread1Done(sender: TObject);
var
  i: integer;
begin
  ListBox1.Items.Clear;
  for i := 1 to MaxSize do
    Listbox1.Items.Add(intToStr(GlobalData[i]));
  //撤消等待,让其他线程可以访问
  ReleaseSemaphore(HSem, 1, nil);
end;

//当线程2执行完后,将GlobalData数据显示出来

procedure TfrmSemaphore.Thread2Done(sender: TObject);
var
  i: integer;
begin
  ListBox2.Items.Clear;
  for i := 1 to MaxSize do
    Listbox2.Items.Add(intToStr(GlobalData[i]));
    //撤消等待,让其他线程可以访问
  ReleaseSemaphore(HSem, 1, nil);
end;


end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?