Тексты программы параллельных взаимодействующих задач

Здесь приведены тексты программы, реализующей параллельное функциониро­вание задач, взаимодействующих между собой в соответствии с рис. 6.6.

program MultiThreads;

uses Forms,

ThrForm in 'ThrForm.pas' {Form1} ,

Threads in 'Threads.pas' ;

($R *.RES}

begin

Application.Initialize;

Application.CreateForm (Tform1,Form1);

Application.Run;

end.

unit ThrForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Gauges, StdCtrls, Threads;

type

Tform1 = class (TForm)

StrButton1: TButton;

GaugeA: Tgauge;

GaugeB: Tgauge;

GaugeC: Tgauge;

GaugeD: Tgauge;

GaugeE: Tgauge;

GaugeF: Tgauge;

GaugeG: Tgauge

Memo1: Tmemo;

Label1: Tlabel;

Label2: Tlabel;

Label3: Tlabel;

Label4: Tlabel;

Label5: Tlabel;

Label6: Tlabel;

Label7: Tlabel;

ScrollBar1: TScrollBar;

Label8: Tlabel;

Label9: Tlabel;

procedure StrButtonIClick(Sender: TObject); { Запуск задач }

procedure FormCreate(Sender: TObject);

procedure ScrollBarlChange(Sender: TObject};

private

{ Private declarations }

public

{ Public declarations }

end;

var

Forml: TForml;

inplementation

{$R *.DFM}

procedure TForml.StrButtonlCLick(Sender: TObject);

{ Запуск задач }

begin

StrButtonl.Enabled =false;

Memol.Clear;

GaugeA.Progress:=0;

GaugeB.Progress:=0;

GaugeC.Progress:=0;

GaugeD.Progress:=0;

GaugeE.Progress:=0;

GaugeF. Progress:=0;

GaugeG.Progress:=0;

AllStarts(GaugeA,GaugeB,GaugeC,GaugeD,GaugeE,GaugeF,GaugeG);

End;

procedure Tform1.FormCreate(Sender: TObject);

begin

StartBtn:=StrButton1;

Delay:=ScrollBar1.Position;

MessageList:=Memo1;

end;

procedure Tform1.ScrollBarlChange(Sender: TObject);

begin

Delay:=ScrollBarl.Position;

end;

end.

unit Threads;

{ Описание тредов }

interface

uses

Classes,Gauges,StdCtrls,Syncobjs;

type

TParams = record { Параметры для инициализации треда}

OwnName:char;

ParentName:char;

Length:integer;

end;

ThreadProgress = class(TThread) { Основной объект-родитель }

private

FGauge:TGauge; { Строка состояния }

FLength:integer; { Длина задачи }

FProgress:Longint; { Текущее состояние задачи }

Finished:boolean; { Признак завершения задачи ]

FName:char; { Имя задачи }

FParentName:char; { Имя запустившей задачи }

FText: string; { Строка для вывода сообщений }

protected

procedure Execute; override; { Выполнение задачи }

procedure DoVisualProgress; { Прорисовка строки состояния}

procedure WriteToMemo; { Вывод сообщения }

procedure Finish; virtual; abstract: { Конечная часть задачи }

public

constructor create(Gauge:TGauge; Params:TParams);

end;

TThreadA = class(ThreadProgress)

protected

procedure Finish; override ;

end;

TThreadB = class(ThreadProgress)

protected

procedure Finish; override;

end;

TThreadC = class(ThreadProgress)

protected

procedure Finish; override:

end;

TThreadD = class(ThreadProgress)

protected

procedure Finish; override;

end;

TThreadE = class(ThreadProgress)

protected

procedure Finish; override;

end;

TThreadF = class(ThreadProgress)

protected

procedure Finish; override;

end;

TThreadG = class(ThreadProgress )

protected

procedure Finish; override;

end;

procedure AllStarts(GaugeA,GaugeB,GaugeC,GaugeD,GaugeE,GaugeF,GaugeG:TGauge);

var StartBtn:TButton;

MessageList:TMemo;

Delay:integer;

Params:Tparams;

ThrA:TThreadA;

ThrB:TthreadB;

ThrC:TThreadC;

ThrD:TThreadD;

ThrE:TthreadE;

ThrF:TThreadF;

ThrG:TThreadG;

CriticalSection: TCriticalSection; { Данный объект позволяет организовать монопольный

доступ к общим ресурсам }

implementation

procedure AllStarts(GaugeA,GaugeB,GaugeC,GaugeD,GaugeE,GaugeF,GaugeG:TGauge);

{ Начало выполнения задач }

begin

Params.OwnName:= ‘A’;

Params.ParentName: =' U ';

Params.Length:=2;

ThrA:=TThreadA.Create(GaugeA,Params);

Params.OwnName:='B';

Params.ParentName :='U';

Params.Length:=4;

ThrB:=TThreadB.Create(GaugeB,Params);

Params.OwnName:='C';

Params.ParentName:=’A';

Params.Length:=2;

ThrC:=TthreadC.Create(GaugeC,Params);

Params.OwnName:='D';

Params.ParentName:='A';

Params.Length:=2;

ThrD:=TThreadD.Create(GaugeD,Params);

Params.OwnName:=’E’;

Params.ParentName:=’A';

Params.Length:=4;

ThrE:=TThreadE.Create(GaugeE,Params) ;

Params.OwnName:=’F’;

Params.ParentName:= ' – ';

Params. Length:=2;

ThrF:=TThreadF.Create(GaugeF,Params);

Params.OwnName:='G';

Params.ParentName:=' – ';

Params.Length:=1;

ThrG :=TThreadG.Create(GaugeG,Params) ;

CriticalSectton:=TCriticalSection.Create;

ThrA.Resume;

ThrB.Resume;

end;

{ ThreadProgress }

procedure ThreadProgress.Execute;

var i:integer;

begin

FText :='3апущена задача '+Fname+' (задачей ’ +FParentName+')';

Synchronize(WriteToMemo);

for i:=1 to FLength do

begin

FProgress:=FProgress+1;

Synchronize{doVisualProgress):

End;

Finish;

Destroy;

end;

constructor ThreadProgress.create(Gauge:Tgauge;Params:TParams);

begin

inherited create(true);

FGauge:=Gauge;

FLength:=delay*Params.Length;

FGauge.MaxValue:=Flength;

FGauge.MinValue:=0;

FGauge.Progress:=0;

FProgress:=0;

FName:=Params.OwnName;

FParentName:=Params.ParentName;

Finished:=false;

end;

procedure ThreadProgress.DoVisualProgress;

begin

FGauge.Progress:=Fprogress;

end;

procedure ThreadProgress.WriteToMemo:

begin

MessageList.Lines.Add(FText);

end;

{ TThreadA }

procedure TThreadA.Finish;

begin

ThrC.Resume;

ThrD.Resume;

ThrE.Resume;

FText:= 'Задача А завершила работу и запустила задачи C,D,E';

Synchronize(WriteToMemo);

Finished:=true;

end;

{ TThreadB }

procedure TThreadB.Finish;

begin

FText:='Задача В завершила свою работу';

Synchronize(WriteToMemo);

Finished:=true;

CriticalSection.Enter; { Начало защищенного блока команд }

try

if (ThrC.Fimshed=false)and(ThrD.Finished=false) then

begin

ThrF.FParentName:='B';

repeat

Synchronize(DoVlsual progress);

until (ThrC.Finished)and(ThrD.Finished);

ThrF.Resume;

FText:='Задача В запустила задачу F';

Synchronize{WriteToMemo);

end;

finally

CriticalSection.Leave; { Конец защищенного блока команд)

end;

end;

{ TthreadC }

procedure TThreadC.Finish;

begin

Ftext:='Задача С завершила свою работу';

Synchronize(WriteToMenro);

Finished:=true;

СritiсаlSection.Enter;

try

if (ThrB.Finished=fa1se)and(ThrD.Finished=false) then

begin

ThrF.FparentName:='C’;

repeat

Synchronize(DoVisualprogress};

until (ThrB.Finished)and(ThrD.Finished);

ThrF.Resume;

FText:='Задача С запустила задачу F';

Synchronize(WriteToMemo) ;

end;

finally

CriticalSection.Leave;

end;

end;

{ TthreadD }

procedure TThreadD.Finish;

begin

FText:=' Задача D завершила свою работу';

Synchronize(WriteToMemo);

Finlshed:=true;

CriticalSection.Enter;

try

if(ThrC.Finished=false)and(ThrB.Finished=false) then

begin

ThrF.FParentName:=' D ‘;

repeat

Synchronize(DoVisualprogress);

unitil(ThrC.Finished)and(ThrB.Finished);

ThrF.Resume;

FТехt:=’Задача D запустила задачу F';

Synchronize(WriteToMemo);

end;

finally

CriticalSection.Leave;

end;

end;

{ TThreadE }

procedure TThreadE.Finish;

begin

Finished:=true;

CnticalSection.Enter;

try

if ThrF.Finished then

begin

ThrG.FParentName:='E';

ThrG.Resume;

FText:='Задача Е завершила работу и запустила задачу G'

Synchronize(WriteToMemo);

end

else

begin

FText:='Задача Е завершила свою работу';

Synchronize(WriteToMemo);

end;

finally

CriticalSection.Leave;

end;

end;

{ TThreadF }

procedure TThreadF.Finish;

begin

Finished:=true;

CriticalSection.Enter;

try

if ThrE.Finished then

begin

ThrG.FParentName:='F’;

ThrG.Resume;

FText:='Задача F завершила работу и запустила задачу G';

Synchronize(WriteToMemo);

end

else

begin

FText:='Задача F завершила свою работу';

Synchronize(WriteToMemo);

end;

finally

CriticaiSection.Leave;

end;

end;

{ TThreadG }

procedure TThreadG.Finish;

begin

Finished:=true;

Ftext:='Задача G завершила работу';

Synchronize(WriteToMemo);

StartBtn.Enabled:=true;

CriticalSection.Free;

end;

end.

ПРИЛОЖЕНИЕ Б