tcrisect.pas

外国人写的各种类型的源代码,有兴趣的朋友看看吧！是学习的好东西哟

unit TCriSect;

interface

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

type
  TListThread = class (TThread)
  private
    Str: String;
  protected
    procedure AddToList;
    procedure Execute; override;
  public
    LBox: TListBox;
  end;

  TForm5 = class(TForm)
    BtnStart: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Th1, Th2: TListThread;
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  Letters: string = 'AAAAAAAAAAAAAAAAAAAA';
  Critical1: TCriticalSection;

implementation

{$R *.DFM}

procedure TListThread.AddToList;
begin
  if Assigned (LBox) then
    LBox.Items.Add (Str);
end;

procedure TListThread.Execute;
var
  I, J, K: Integer;
begin
  for I := 0 to 50 do
  begin
    Critical1.Enter;
    for J := 1 to 20 do
      for K := 1 to 2601 do // useless repetition...
        if Letters [J] < 'Z' then
          Letters [J] := Succ (Letters [J])
        else
          Letters [J] := 'A';
    Str := Letters;
    Critical1.Leave;
    Synchronize (AddToList);
  end;
end;

procedure TForm5.BtnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  Th1 := TListThread.Create (True);
  Th2 := TListThread.Create (True);
  Th1.LBox := Listbox1;
  Th2.LBox := Listbox2;
  Th1.Resume;
  Th2.Resume;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  Critical1 := TCriticalSection.Create;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
  Critical1.Free;
end;

end.