Delphi Thread Example

Delphi Thread Example

Threads mean a lot with the latest computer technology. They allow you to perform multiple tasks at the same time without them interfering with each other. For example, imagine a road. If this road is only 1 lane, and there is a large truck driving slowly, then everyone else gets stuck behind that truck and cannot pass. When the road has two lanes, all the faster moving cars can move over to the other lane and pass the slow truck.

Threads allow similar capabilities: One block of code can be running on its own while another block of code is also running on its own - in the same application. By default, any simple application has its own main thread. You have the choice of adding more threads to allow more things to go on at the same time. For example, you might need to write a thread which performs some very lengthy calculations, while allowing the main GUI thread to continue responding.

Given a sample program and unit source code to understand easily about Delphi thread usage.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    procedure AddMemoItems;
    { Private declarations }
  public
    { Public declarations }
  end;

  TNewObj = class
    private
      procedure GetValue;
    public
    end;

  TAddMemoItems = procedure of object;// Method pointer

  TNewThread = class(TThread)         // Creating a Thread object
  private
    FName: TMemo;                     // Assigning the Memo control into the pointer
    FAscFlag : Boolean;               // Assigning the loop order flag into the pointer
    FAddMemoItems : TAddMemoItems;    // variable of method pointer
    FPause : Boolean;
    procedure RefreshThread;          // Normal procedure to use for thread synchronize process
  protected
    procedure Execute; override;      // Actual thread execution
    procedure Pause;
    procedure Start;
  public
    constructor Create(Name: TMemo; AscFlag:Boolean; AddMemoItems: TAddMemoItems);
            // Constructor method of thread and passing Memo, loop Asending flag and Method pointer as parameters
    destructor Destroy; override;
  end;


var
  Form1: TForm1;
  t1, t2, t3 : TNewThread;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  t1 := TNewThread.Create(Memo1,true, AddMemoItems);
  t3 := TNewThread.Create(Memo1,true, nil);
  //ShowMessage('Start next thread');
  t2 := TNewThread.Create(Memo2,false, nil);
  //t1.Priority := tpLower;
  //t1.Resume;
  //ShowMessage('Start next thread');
  //t2.Priority := tpLower;
  //t2.Resume;
end;

procedure TForm1.AddMemoItems;
var
  i : integer;
begin
  for i := 1 to 1000 do
  begin
    Memo1.Lines.Add(IntToStr(i));
  end;
end;

{ TNewThread }

constructor TNewThread.Create(Name: TMemo; AscFlag:Boolean; AddMemoItems: TAddMemoItems);
begin
  inherited Create(True);
  //FName := 'th'+Name;
  FName    := Name;
  FAscFlag := AscFlag;
  FAddMemoItems := AddMemoItems;
  Priority := tpLower;
  Resume;
end;

destructor TNewThread.Destroy;
begin

  inherited;
end;

procedure TNewThread.Execute;
var
  i, iStNo : integer;
begin
  inherited;
  iStNo := 0;
  if FAscFlag then
  begin
    if Assigned(FAddMemoItems) then
      FAddMemoItems
    else
    begin
      for i := 1 to 1000 do
      begin
        while FPause do Inc(iStNo);
        FName.Lines.Add(IntToStr(i));
        //Synchronize(RefreshThread);
        Sleep(Random(10));
      end;
    end;
  end
  else
  begin
    for i := 1000 downto 1 do
    begin
      while FPause do Inc(iStNo);
      FName.Lines.Add(IntToStr(i));
      //Synchronize(RefreshThread);
      Sleep(Random(10));
    end;
  end;
end;

procedure TNewThread.Pause;
begin
  FPause := True;
end;

procedure TNewThread.RefreshThread;
begin
  //Nothing do
end;

procedure TNewThread.Start;
begin
  FPause := False;
end;

{ TNewObj }

procedure TNewObj.GetValue;
begin
  ShowMessage(Form1.Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  obj : TNewObj;
begin
  obj := TNewObj.Create;
  obj.GetValue;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  t3.Pause;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  t3.Start;
end;

end.