Пример работы с потоками

Delphi , Компоненты и Классы , Потоки

Автор: Xavier Pacheco

unit Main;

interface

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

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    Options1: TMenuItem;
    AddThread: TMenuItem;
    RemoveThread: TMenuItem;
    ColorDialog1: TColorDialog;
    Add10: TMenuItem;
    RemoveAll: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AddThreadClick(Sender: TObject);
    procedure RemoveThreadClick(Sender: TObject);
    procedure Add10Click(Sender: TObject);
    procedure RemoveAllClick(Sender: TObject);
  private
    ThreadList: TList;
  public
    { Public declarations }
  end;

  TDrawThread = class(TThread)
  private
    FColor: TColor;
    FForm: TForm;
  public
    constructor Create(AForm: TForm; AColor: TColor);
    procedure Execute; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

{ TDrawThread }

constructor TDrawThread.Create(AForm: TForm; AColor: TColor);
begin
  FColor := AColor;
  FForm := AForm;
  inherited Create(False);
end;

procedure TDrawThread.Execute;
var
  P1, P2: TPoint;

  procedure GetRandCoords;
  var
    MaxX, MaxY: Integer;
  begin
    // initialize P1 and P2 to random points within Form bounds
    MaxX := FForm.ClientWidth;
    MaxY := FForm.ClientHeight;
    P1.x := Random(MaxX);
    P2.x := Random(MaxX);
    P1.y := Random(MaxY);
    P2.y := Random(MaxY);
  end;

begin
  FreeOnTerminate := True;
  // thread runs until it or the application is terminated
  while not (Terminated or Application.Terminated) do
  begin
    GetRandCoords; // initialize P1 and P2
    with FForm.Canvas do
    begin
      Lock; // lock canvas
      // only one thread at a time can execute the following code:
      Pen.Color := FColor; // set pen color
      MoveTo(P1.X, P1.Y); // move to canvas position P1
      LineTo(P2.X, P2.Y); // draw a line to position P2
      // after the next line executes, another thread will be allowed
      // to enter the above code block
      Unlock; // unlock canvas
    end;
  end;
end;

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ThreadList := TList.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  RemoveAllClick(nil);
  ThreadList.Free;
end;

procedure TMainForm.AddThreadClick(Sender: TObject);
begin
  // add a new thread to the list... allow user to choose color
  if ColorDialog1.Execute then
    ThreadList.Add(TDrawThread.Create(Self, ColorDialog1.Color));
end;

procedure TMainForm.RemoveThreadClick(Sender: TObject);
begin
  // terminate the last thread in the list and remove it from list
  TDrawThread(ThreadList[ThreadList.Count - 1]).Terminate;
  ThreadList.Delete(ThreadList.Count - 1);
end;

procedure TMainForm.Add10Click(Sender: TObject);
var
  i: Integer;
begin
  // create 10 threads, each with a random color
  for i := 1 to 10 do
    ThreadList.Add(TDrawThread.Create(Self, Random(MaxInt)));
end;

procedure TMainForm.RemoveAllClick(Sender: TObject);
var
  i: Integer;
begin
  Cursor := crHourGlass;
  try
    for i := ThreadList.Count - 1 downto 0 do
    begin
      TDrawThread(ThreadList[i]).Terminate; // terminate thread
      TDrawThread(ThreadList[i]).WaitFor; // make sure thread terminates
    end;
    ThreadList.Clear;
  finally
    Cursor := crDefault;
  end;
end;

initialization
  Randomize; // seed random number generator
end.

Статья Пример работы с потоками раздела Компоненты и Классы Потоки может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Потоки ::