threadexample

Here is a thread example:

unit thread;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, OleCtrls, ComCtrls;

type
TForm1 = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Button1: TButton;
    Button2: TButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
private
    { Private declarations }
    procedure StartThreads;
    procedure StopThreads;
    procedure SuspendThreads;
    procedure ResumeThreads;
public
    Thread1: TThread;
    Thread2: TThread;
    Thread3: TThread;
    { Public declarations }
end;

{Thread Class that changes shape}
TShapeThread = class(TThread)
private
    FShape: TShape;
    { Private declarations }
protected
    procedure Execute; override;
public
    constructor Create(Shape: TShape);
    procedure ChangeShape;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{Creates the thread. Passes the thread the shape
it will change}
constructor TShapeThread.Create(Shape: TShape);
begin
inherited Create(False);
FShape:=Shape;
FreeOnTerminate := True;
end;

{Thread execute method. Loops until thread is
terminated. Calls the ChangeShape method to
change shape to next form. Use Synchronize to
make sure the thread behave properly when accessing
VCL}
procedure TShapeThread.Execute;
begin
while not Terminated do
begin
Synchronize(ChangeShape);
end;
end;

{Changes Shape to next Shape Type}
procedure TShapeThread.ChangeShape;
begin
if FShape.Shape=High(FShape.Shape) then
FShape.Shape:=Low(FShape.Shape)
else
FShape.Shape:=TShapeType(Ord(FShape.Shape)+1);
FShape.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StartThreads; {Start all threads when form is created}
end;

{Create a thread for each Shape}
procedure TForm1.StartThreads;
begin
Thread1:=TShapeThread.Create(Shape1);
Thread2:=TShapeThread.Create(Shape2);
Thread3:=TShapeThread.Create(Shape3);
end;

{Terminate all Threads}
procedure TForm1.StopThreads;
begin
Thread1.Terminate;
Thread2.Terminate;
Thread3.Terminate;
end;

{Suspend execution of all Threads}
procedure TForm1.SuspendThreads;
begin
Thread1.Suspended:=True;
Thread2.Suspended:=True;
Thread3.Suspended:=True;
end;

{Resume execution of all Threads}
procedure TForm1.ResumeThreads;
begin
Thread1.Suspended:=False;
Thread2.Suspended:=False;
Thread3.Suspended:=False;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
SuspendThreads; {Suspend all Threads}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ResumeThreads; {Resume Thread execution of Threads}
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
{Change Threads priority based on TrackBar position}
Thread1.Priority:=TThreadPriority(TrackBar1.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
{Change Threads priority based on TrackBar position}
Thread2.Priority:=TThreadPriority(TrackBar2.Position);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
{Change Threads priority based on TrackBar position}
Thread3.Priority:=TThreadPriority(TrackBar3.Position);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
StopThreads; {Stop all Threads}
end;

end.

{** the DFM file **}

object Form1: TForm1
Left = 48
Top = 159
Width = 584
Height = 254
Caption = 'Apogee Multi-Threading Demo'
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Position = poScreenCenter

OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Shape1: TShape
    Left = 36
    Top = 9
    Width = 105
    Height = 89
    Brush.Color = clAqua
    Brush.Style = bsBDiagonal
    Shape = stCircle
end
object Shape2: TShape
    Left = 232
    Top = 8
    Width = 105
    Height = 89
    Brush.Color = clRed
    Brush.Style = bsDiagCross
end
object Shape3: TShape
    Left = 440
    Top = 8
    Width = 105
    Height = 89
    Brush.Color = clBlue
end
object Button1: TButton
    Left = 128
    Top = 192
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = Button1Click
end
object Button2: TButton
    Left = 372
    Top = 192
    Width = 75
    Height = 25
    Caption = 'Stop'
    TabOrder = 1
    OnClick = BitBtn1Click
end
object TrackBar1: TTrackBar
    Left = 12
    Top = 132
    Width = 150
    Height = 45
    Max = 6
    Orientation = trHorizontal
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 2
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
end
object TrackBar2: TTrackBar
    Left = 208
    Top = 132
    Width = 150
    Height = 45
    Max = 6
    Orientation = trHorizontal
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 3
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar2Change
end
object TrackBar3: TTrackBar
    Left = 416
    Top = 132
    Width = 150
    Height = 45
    Max = 6
    Orientation = trHorizontal
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 4
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar3Change
end
end