main.pas

来自「关于利用DELPHI来进行企业级方案解决的著作的附书源码」· PAS 代码 · 共 130 行

unit main;

{ Copyright (c) 1996 by Charlie Calvert

  Shows how to use Mutexs when working with threads.
  The program intentionally creates an error condition
  and then shows how to use Mutexs to straighten
  the program out. }

interface

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

const
  TotalCount = 20;
    
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    MainMenu1: TMainMenu;
    Options1: TMenuItem;
    RunThread1: TMenuItem;
    UseMutex1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RunThread1Click(Sender: TObject);
    procedure UseMutex1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  UseMutex: Boolean;
  hMutex: THandle;
  GlobalData: Integer;

/////////////////////////////////////////////////////////
// The thread routine
/////////////////////////////////////////////////////////
function ThreadFunc1(P: Pointer): LongInt; stdcall;
var
  i, j: Integer;
  S: string;
begin
  Form1.ListBox1.Items.Clear;

  for j := 0 to TotalCount do begin
    if (UseMutex) then WaitForSingleObject(hMutex, INFINITE);
    Sleep(3);
    Inc(GlobalData, 3);
    i := GlobalData - 3;
    S := Format('Information: %d', [i]);
    SendMessage(Form1.ListBox1.Handle, lb_AddString, 0, LongInt(S));
    Dec(GlobalData, 3);
    if (UseMutex) then ReleaseMutex(hMutex);
  end;
  Result := 0;
end;

/////////////////////////////////////////////////////////
// The thread routine
/////////////////////////////////////////////////////////
function ThreadFunc2(P: Pointer): LongInt; stdcall;
var
  i, j: Integer;
  S: string;
begin
  Form1.ListBox2.Clear;

  for j := 0 to TotalCount do begin
    if (UseMutex) then WaitForSingleObject(hMutex, INFINITE);
    Sleep(3);
    Dec(GlobalData, 3);
    i := GlobalData + 3;
    S := Format('Information: %d', [i]);
    SendMessage(Form1.ListBox2.Handle, lb_AddString, 0, LongInt(S));
    Inc(GlobalData, 3);
    if (UseMutex) then ReleaseMutex(hMutex);
  end;

  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hMutex := CreateMutex(nil, False, nil);
  UseMutex := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hMutex);
end;

procedure TForm1.RunThread1Click(Sender: TObject);
var
  ThreadID1: DWord;
  ThreadID2: DWord;
  ThreadHandles: array [0..1] of THandle;
begin
  GlobalData := 100;

  ThreadHandles[0] := CreateThread(nil, 0, @ThreadFunc1,
                       nil, 0, ThreadID1);

  ThreadHandles[1] := CreateThread(nil, 0, @ThreadFunc2,
                       nil, 0, ThreadID2);

  if (ThreadHandles[0] = 0) or (ThreadHandles[1] = 0) then
    MessageBox(Handle, 'No Thread', nil, MB_OK);
end;

procedure TForm1.UseMutex1Click(Sender: TObject);
begin
  UseMutex1.Checked := not UseMutex1.Checked;
  UseMutex := UseMutex1.Checked;
end;

end.