main.pas

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

unit main;

{ Copyright 1996 by Charlie Calvert

  Shows how to use Critical Sections with Threads
  You can run code either with, or without Critical
  Sections turned on. They are turned on when the
  check mark appears next to the appropriate item
  in the CritSect's menu. }
  
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;
    CritSects1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RunThread1Click(Sender: TObject);
    procedure CritSects1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  CritSects: Boolean;
  Sect1: TRTLCriticalSection;
  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 (CritSects) then EnterCriticalSection(Sect1);
    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 (CritSects) then LeaveCriticalSection(Sect1);
  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 (CritSects) then EnterCriticalSection(Sect1);
    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 (CritSects) then LeaveCriticalSection(Sect1);
  end;

  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitializeCriticalSection(Sect1);
  CritSects := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(Sect1);
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.CritSects1Click(Sender: TObject);
begin
  CritSects1.Checked := not CritSects1.Checked;
  CritSects := CritSects1.Checked;
end;

end.