unitmainsemaphore.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit UnitMainSemaphore;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Gauge1: TGauge;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    SemaphoreHandle: THandle;
    ThreadHandle: THandle;
    WaitRTn: DWord;
    procedure ShowProgress;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ShowProgress;
var
  ICount: Integer;    // general loop counter
begin
  {wait for the semaphore, and get ownership. this decreases the
   semaphore's count by one. if the semaphore is currently at 0,
   this function will block until the semaphore's count increases}
  WaitForSingleObject(SemaphoreHandle, INFINITE);

  {display a visual indicator}
  for ICount := 1 to 1000 do
  begin
    Gauge1.Progress := ICount;
  end;

  {release the semaphore, and increase its count by 1}
  ReleaseSemaphore(Form1.SemaphoreHandle, 1, nil);
end;

{you will want to click this button numerous times to get several child
 processes on the screen at once. the more you have, the better a demonstration
 of thread synchronization this example will be}
procedure TForm1.Button1Click(Sender: TObject);
var
  StartUpInfo: TStartUpInfo;        // holds startup information
  ProcessInfo: TProcessInformation; // holds process information
  CurDir: string;                   // holds the current directory
begin
  {initialize the startup info structure}
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_SHOWNORMAL;
  end;

  {launch the semaphore sibling program for the example}
  CurDir := ExtractFilePath(ParamStr(0))+'ProjectOpenSemaphore.exe';
  CreateProcess(PChar(CurDir), nil, nil, nil, False,
      NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  OldValue: DWORD;  // holds the previous semaphore count
begin
  {release the semaphore. this sets the semaphore's available count
   to 2 which will allow up to 2 threads access}
  ReleaseSemaphore(SemaphoreHandle, 2, @OldValue);

  {start the visual indication}
  ShowProgress;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {create the semaphore, with an initial count of 0 (non-signaled)
   and a maximum count of 2}
  SemaphoreHandle := CreateSemaphore(nil, 0, 2, 'TheSemaphore');
end;

end.