методички / 4045 ЭИ
.pdfПриложение 3
StartTime,EndTime: TDateTime; // Временные интервалы процесса
// Запустить соседние процессы по окончанию текущего
Procedure StartProcessesNeighbor; public
DataVision: TDataVision;
Position: extended; // Расчет позиции ProgressBar
btReadOn: boolean; |
// Флаг разрешения чтения данных |
|
ID : integer; // Идентификатор потока |
||
mRep : TMemo; |
|
// Отчет процессов по завершению |
evs : TEvent; |
// Событие «Открыть/Закрыть семафор» |
|
res: TWaitResult; |
// Результат от ожидаемого события; |
|
function getPriority(pri: TThreadPriority): string; |
||
Procedure Report; |
// Отчет о затраченном времени по завершению |
|
Procedure starTHread; // Запуск процесса
Procedure setPriory(set_: integer); // Установка приоритета constructor Create(Suspended_: Boolean;
id_:integer; priory: integer;
DataVision_: TDataVision; mem_: TMemo);
protected
procedure Execute; override; // Процедура потока
procedure DoWork; // Установка параметров видимых элементов end;
{Класс блокируемой коллекции потоков TCollthreadlist}
TCollthreadlist = class(tthreadlist) private
public
curentVisioItem: integer; // Текущий индекс просматриваемого элемента constructor create;
Destructor Destroy; override;
procedure ClearThread; // Clear коллекции с деструкцией объектов потока end;
implementation
{TCollthreadlist}
constructor TCollthreadlist.Create; begin
inherited Create;
// Счетчик-индекс опроса данных на исходную позицию curentVisioItem := 0;
end;
Destructor TCollthreadlist.Destroy; begin
ClearThread; inherited;// Destroy;
end;
procedure TCollthreadlist.ClearThread; var i: integer;
begin
for i:=0 to self.LockList.Count-1 do // Проход по коллекции with TMyThread(Tthread(LockList.Items[i])) do
begin
if res = wrAbandoned then
evs.SetEvent; // Отмена evs.WaitFor(INFINITE) evs.Release; // Остановка и удаление семафора
41
Приложение 3
Destroy; // Освобождение ресурсов от потока end;
self.LockList.Clear;
end;
{TMyThread}
constructor TMyThread.Create(Suspended_: Boolean; id_:integer; // id процесса priory: integer; // Приоритет
DataVision_: TDataVision; // Обмен mem_: TMemo); // Объект вывода отчета
begin
inherited Create(Suspended_);
btReadOn := false; // разрешение чтения данных
DataVision:=DataVision_; id := id_; // идентификатор
{Если FreeOnTerminate имеет значение True, то VCL автоматически разрушает объект потока при его завершении}
FreeOnTerminate := false; // Объект будет разрушаться программно
|
// для получения признака not Assigned() |
setPriory(priory); |
// Уровень приоритета 0-6 |
mRep := mem_; |
// Memo для формирования отчета |
//Событие «Открыть семафор», True - «ручное» управление семафором;
//false - начальное состояние, переключится на TRUE (сигнальное)
//после события SetEvent
evs := TEvent.Create(nil,True,false, 'semafor'+inttostr(id_)); end;
Procedure TMyThread.starTHread; begin
StartTime := Time; if Suspended then
Start; // Запуск потока end;
//Пример взаимодействия потоков в коллекции:
//запустить соседние процессы по окончанию текущего
Procedure TMyThread.StartProcessesNeighbor;
begin
//Запустить предыдущий процесс, если он в состоянии ожидания if (DataVision.idx > 0) and
(TMyThread(DataVision.ParentList.Items[DataVision.idx-1]).res = wrAbandoned) then
TMyThread(DataVision.ParentList.Items[DataVision.idx-1]).evs.SetEvent;
//Запустить следующий процесс, если он в состоянии ожидания
if ((DataVision.idx+1) <= DataVision.ParentList.Count-1) and (TMyThread(DataVision.ParentList.Items[DataVision.idx+1]).res = wrAbandoned) then
TMyThread(DataVision.ParentList.Items[DataVision.idx+1]).evs.SetEvent; end;
Procedure TMyThread.setPriory(set_: integer); begin
Priority := CThreadPriority[set_]; // тип приоритета end;
procedure TMyThread.Execute;
42
Приложение 3
begin
res := wrAbandoned; // Установим признак закрытого семафора with DataVision do begin
while (FCounter < FCountTo) and not(self.Terminated) do begin
// Если Семафор закрыт
if res = wrAbandoned then begin
//Установить состояние семафора - «Стоп» (вкл, «красный цвет») evs.ReSetEvent;
//INFINITE ждать события открытия семафора бесконечно долго res := evs.WaitFor(INFINITE);
end;
if FCounter mod Interval = 0 then
DoWork; // Асинхронный вывод данных работы потока на панель (VCL) Inc(FCounter);
end;
EndTime := Time;
//Завершить оформление вывода if not(self.Terminated) then begin
Dec(FCounter);
DoWork; // Завершение вывода данных end;
//Пример взаимодействия потоков:
//запустить соседние процессы по окончанию текущего
StartProcessesNeighbor;
//Синхронизированный отчет потока
Synchronize(@Report); // о затраченном времени
end;
end;
// Асинхронный вывод данных на интерфейсную панель procedure TMyThread.DoWork;
begin
btReadOn := false; // блокировать чтение данных потока with DataVision do begin
// Изменить данные процесса
PctDone := (FCounter / FCountTo); // относительная часть выполненного Position := Round(Step * PctDone); // задания (progressbar)
end;
btReadOn := true; // Разрешить чтение данных для визуального наблюдения end;
// Отчет по затраченному времени procedure TMyThread.Report; begin
mRep.Append(' ID: '+Format('%.3d',[id])+' Время '+ FormatDateTime('hh:mm:ss:zzz', StartTime-EndTime));
end;
// Пример функции чтения текущего приоритета потока function TMyThread.getPriority(pri: TThreadPriority): string; begin
case pri of
tpTimeCritical: result :='Time Critical'; tpHighest: result :='Highest'; tpHigher: result :='Higher';
43
Приложение 3
tpNormal: result :='Normal'; tpLower: result :='Lower'; tpLowest: result :='Lowest'; tpIdle: result :='Idle';
end;
end;
end.
П3.2. Многомерные потоки - организация взаимодействия и синхронного управления (Lazarus)
Программное описание интерфейса управления связанных потоков событиями синхронного управления и асинхронного взаимодействия потоков с VCL. Ознакомиться с примером, создать собственный интерфейс управления потоками, в минимальном исполнении содержащий кнопки создания, синхронного запуска и останова-удаления потоков.
Модуль классов интерфейсов управления потоком. Интерфейсные элементы со-
здаются из шаблона, хранимого в стандартном файловом потоке. Число интерфейсов создается по числу объявленных пользователем потоков. Интерфейсные панели размещаются в ячейках таблицы, выдают при выборе ID потока, а также управляют изменением приоритета потока. В свою очередь, потоки асинхронно, без организации очереди к главному потоку на взаимодействие с VCL, отображают на панелях прогресс выполнения задания. На интерфейсной панели введен новый элемент – checkbox, включающий по команде пользователя поток, а также переводящий поток в состояние паузы. По окончании основной процедуры, поток запускает соседние потоки по событию синхронизации, с условием, если они находились в состоянии ожидания (семафор закрыт).
{АСИНХРОННЫЙ ОБМЕН ДАННЫМИ С VCL; форма интерфейсных элементов потоков (процессов); методы взаимодействия потоков и интерфейсов; управление потоками через интерфейсы, взаимо-
действие потоков посредством включения/выключения семафоров}
unit Unit1;
{$mode objfpc}{$H+} interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids, Spin,unit2,SyncObjs;
type
{ TForm1 }
TForm1 = class(TForm) btSaveComponentInStream: TButton; btStop: TButton;
chOnOff: TCheckBox; GroupBox5: TGroupBox; Label4: TLabel;
Label5: TLabel; LoadComponentInStream: TButton; ComboBox1: TComboBox; GroupBox1: TGroupBox; GroupBox2: TGroupBox; GroupBox3: TGroupBox; GroupBox4: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel; mfReport: TMemo;
44
Приложение 3
Panel1: TPanel;
Panel2: TPanel; ProgressBar1: TProgressBar; ScrollBox1: TScrollBox; SpinEdit1: TSpinEdit; StatusBar1: TStatusBar; StringGrid1: TStringGrid;
procedure btSaveComponentInStreamClick(Sender: TObject); procedure btStopClick(Sender: TObject);
// Событие синхронного управления потоком procedure chOnOffChange(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject);
procedure LoadComponentInStreamClick(Sender: TObject); private
//Компоненты управления от интерфейсной панели к потоку procedure GBoxClick(Sender: TObject);
procedure ComboClick(Sender: TObject);
//Фоновый обмен от потока к интерфейсной панели
procedure IdleEventHandler(Sender: TObject; var Done: Boolean); procedure ShowDataPanel(ind: integer; DataVision_: TDataVision); procedure Start_Idle; // Старт - Фоновый опрос данных вывода потоков procedure Stop_Idle; // Стоп -//-
public
ListProcess: TList; // Список процессов { public declarations }
end; var
Form1: TForm1; threadlist:TCollthreadlist;
implementation {$R *.lfm}
{ TForm1 }
// Передача данных в асинхронном режиме на панель управления procedure TForm1.ShowDataPanel(ind: integer; DataVision_: TDataVision); var GBox: TGroupBox;
begin
//Получить ссылку на интерфейсную панель
GBox := TGroupBox(StringGrid1.Objects[0, ind]);
//Проставить на панели:
//Процент выполнения
(GBox.Controls[2] as TLabel).Caption:=FormatFloat('0.00 %', DataVision_.PctDone * 100); // Статус-линия прогресса
(GBox.Controls[3] as TProgressBar).Position:=Round(DataVision_.Step * DataVision_.PctDone); end;
// Фоновое событие асинхронного опроса измененных данных потока procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean); var
item: TMyThread; // элемент потока из коллекции begin
Label4.Caption := FormatDateTime('hh:mm:ss', Time); // Индикатор активности Idle if not (threadlist.curentVisioItem < threadlist.LockList.Count) then
// Cписок пройден - устанавливаем цикл на начало threadlist.curentVisioItem :=0;
item:= TMyThread(threadlist.LockList.Items[threadlist.curentVisioItem]); if item.btReadOn then begin // Есть разрешение на чтение
ShowDataPanel(threadlist.curentVisioItem, item.DataVision); // Вывод данных item.btReadOn := false; // Не просматривать пока не обновятся данные
end;
Inc(threadlist.curentVisioItem); // Переход на следующий эл-т коллекции Done := false;
45
Приложение 3
end;
procedure TForm1.Start_Idle; // Старт - Фоновый опрос данных вывода потоков begin
// Назначить обработчик событию процесса Idle if Application.OnIdle = nil then
Application.OnIdle := @IdleEventHandler;
end;
procedure TForm1.Stop_Idle; // Стоп -//- begin
// Отменить обработку события процесса Idle Application.OnIdle := nil;
Label4.Caption:='---'; end;
// Запись панели управления в файловый поток (создание шаблона интерфейса) procedure TForm1.btSaveComponentInStreamClick(Sender: TObject);
var
Stream: TFileStream ; St: TStringList;
S: String; begin
Stream := TFileStream.Create( 'CompFile', fmCreate ) ; try
Stream.WriteComponent( GroupBox2 ); Stream.WriteComponent( Label1 ); // ID потока
Stream.WriteComponent( ComboBox1 ); // Управление приоритетом Stream.WriteComponent( Label2 ); // Процент выполнения задания Stream.WriteComponent( ProgressBar1 );// Линия прогресса
// Check запуска/останова процесса (открытие/закрытие семафора)
Stream.WriteComponent( chOnOff );
St := TStringList.Create; // Строки меню выбора приоритета
St.Add('Высший');
St.Add('Высокий');
St.Add('Выше среднего'); St.Add('Нормальный'); St.Add('Ниже среднего'); St.Add('Низкий');
St.Add('Низший'); S:= St.Text;
Stream.Write(Pointer(S)^, Length(S) * SizeOf(Char)); // Запись формы в файл finally begin
Stream.Free ; St.Free;
ShowMessage('Панель уcпешно сохранена в потоке'); end
end ; end;
// Остановка-удаление потоков
procedure TForm1.btStopClick(Sender: TObject); var i: integer;
begin
if not(Assigned(ListProcess)) then
ShowMessage('Процессы уже выключены!') else
if (StringGrid1.ColCount=0) then ShowMessage('Процессы еще не загружены!')
else
// выключаем-удаляем процессы begin
Stop_Idle; // Остановка асинхронного вывода // Освобождаем ресурсы от процессов threadlist.ClearThread;
46
Приложение 3
// Очистка таблицы
if StringGrid1.RowCount > 0 then begin for i := 0 to StringGrid1.RowCount - 1 do
StringGrid1.Objects[0,i].Destroy; StringGrid1.RowCount := 0;
end;
StatusBar1.Panels[1].Text := 'Список процессов удален'; end;
end;
// Включить/пауза/продолжение потока на его интерфейсной панели procedure TForm1.chOnOffChange(Sender: TObject);
var ch: TCheckBox absolute Sender; cur_thr: TMyThread;
begin
// Параметр-ссылка на выбранный поток в коллекции cur_thr := TMyThread(ListProcess.Items[
strtoint((ch.parent.Controls[0] as TLabel).Caption)-1 ]);
if ch.Checked then begin
//Послать событие открытия семафора
//cur_thr.res получает значение wrSignaled cur_thr.evs.SetEvent; StatusBar1.Panels[1].Text :=
'Процесс '+(ch.Parent as TGroupBox).caption+' снят с паузы';
end
else begin
cur_thr.res := wrAbandoned; // Закрыть семафор StatusBar1.Panels[1].Text :=
'Процесс '+(ch.Parent as TGroupBox).caption+' приостановлен'
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin
threadlist.ClearThread; // Удалить коллекцию процессов end;
// Регистрация стандартных компонент (для создания интерфейсной панели) procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterClass( TGroupBox );// Регистрация компонент, которые
RegisterClass( TLabel ); // сохраняются в файле на форме интерфейса потока
RegisterClass( TProgressBar );
RegisterClass( TComboBox );
RegisterClass( TStringList );
RegisterClass( TCheckBox );
threadlist := TCollthreadlist.Create; // Создать коллекцию потоков end;
// Загрузить цепь процессов и панелей управления (клонировать из файла) procedure TForm1.LoadComponentInStreamClick(Sender: TObject);
var
Stream : TFileStream ; GBox: TGroupBox; Lb1,Lb2: TLabel; CBox: TComboBox; PBar: TProgressBar;
St: TStringList; ch: TCheckBox; rect :TRect; i, idx, itm :integer; DataVision: TDataVision;
begin
if threadlist.LockList.Count>0 then begin
ShowMessage('Процессы уже загружены!'); exit;
47
Приложение 3
end;
// Очистить таблицу от интерфейсов предыдущей коллекции if StringGrid1.RowCount > 0 then begin
for i := 0 to StringGrid1.RowCount - 1 do StringGrid1.Objects[0,i].Destroy;
StringGrid1.RowCount := 0; end;
ListProcess := threadlist.LockList; // Получить ссылку на коллекцию mfReport.Clear; // размещения потоков
// Подготовить данные визуального отображения with DataVision do begin
FCounter := 0; // Текущий счетчик процесса
Interval := 10000000; // Интервал обращения процесса к изменению данных
FCountTo := round(MAXINT/2); // Конечное число цикла Step := FCountTo div Interval; // Шаг прогресс-линии
// Коллекция, где регистрируется поток
ParentList := ListProcess; end;
// Читать форму интерфейса из потока
Stream := TFileStream.Create( 'CompFile', fmOpenRead ) ; try
Randomize; // Инициализировать генератор случайных чисел for i:=0 to (SpinEdit1.Value-1) do begin
Stream.Seek(0, soBeginning); // Начальная позиция чтения шаблона интерфейса
//Читать: форму-бокс интерфейсной панели из файла-потока
GBox := Stream.ReadComponent( nil ) as TGroupBox ; GBox.Parent := self;
//...обозначение идентификатора потока
Lb1:= Stream.ReadComponent( nil ) as TLabel ; Lb1.Parent := GBox;
// ...выпадающий список выбора приоритета
CBox := Stream.ReadComponent( nil ) as TComboBox ; CBox.Parent := GBox;
// ...процент выполнения
Lb2:= Stream.ReadComponent( nil ) as TLabel ; Lb2.Parent := GBox;
// ...линия прогресса
PBar := Stream.ReadComponent( nil ) as TProgressBar ; PBar.Parent := GBox;
//...check включения/выключения семафора потока ch := Stream.ReadComponent( nil ) as TCheckBox ; ch.Parent := GBox;
//...строки меню выбора приоритета
St := TStringList.Create;
St.LoadFromStream(Stream);
//Строки меню в список выбора
CBox.Items.BeginUpdate; CBox.Items := St; CBox.Items.EndUpdate; CBox.ItemIndex := 0;
Lb1.Caption := IntToStr(i+1); // Номер интерфейсной панели
//Назначить события:
//1) отображения информации при выборе панели интерфейса и
//назначении приоритета потоку
GBox.ControlStyle := [csClickEvents]; GBox.OnClick := @GBoxClick; // панель
(GBox.Controls[1] as TComboBox).OnChange := @ComboClick; // приоритет
// 2) Старт/стоп потока - check на панели
(GBox.Controls[4] as TCheckBox).OnChange :=@chOnOffChange;
//Отоьражение ID потока на панели интерфейса
GBox.Caption :='Id ' + inttostr(100+i);
itm := 1 + Random(6); // Случайный выбор приоритета
(GBox.Controls[1] as TComboBox).ItemIndex:=itm;
//Назначить интерфейсу владельца - таблицу строк
GBox.Parent := StringGrid1;
48
Приложение 3
//Создать строку в таблице для размещения интерфейса
StringGrid1.RowCount:=StringGrid1.RowCount+1;
//«Прямоугольник» в ячейке таблицы для размещения панели интерфейса rect:=StringGrid1.CellRect(0,i);
//«Подгон» ячейки под размеры панели
GBox.Top:=rect.Top;
GBox.Left:=rect.Left;
if i = 0 then
StringGrid1.ColWidths[0]:= GBox.Width; // Ширина колонки с панелями
//Высота строки с панелью
StringGrid1.RowHeights[i] := GBox.Height;
//Установки линии прогресса на панели интерфейса
(GBox.Controls[3] as TProgressBar).Max:=DataVision.Step; (GBox.Controls[3] as TProgressBar).Step:=DataVision.Step;
//«Вставить» панель интерфейса в ячейку таблицы
StringGrid1.Objects[0, i] := GBox;
//Создать и добавить поток в коллекцию
idx := ListProcess.Add(TMyThread.Create(true,i+100,itm,DataVision,mfReport)); // Индекс потока в коллекции
TMyThread(ListProcess.Items[idx]).DataVision.idx:=idx; end; // for
finally
Stream.Free; // Освобождение ресурсов файлового stream - источника объектов end ;
// включаем процессы
for i:=0 to ListProcess.Count-1 do TMyThread(ListProcess.Items[i]).starTHread;
StatusBar1.Panels[1].Text := 'Процессы загружены и включены';
Start_Idle; // Старт асинхронного вывода данных процессов end;
// «Щелчок» по панели управления
procedure TForm1.GBoxClick(Sender: TObject); var
Gboxed: TGroupBox absolute Sender; begin
StatusBar1.Panels[1].Text := 'Выбор панели управления процессом: ' + Gboxed.caption; end;
// Изменение приоритета на панели управления procedure TForm1.ComboClick(Sender: TObject); var
TCombo: TComboBox absolute Sender; begin
if threadlist.LockList.Count=0 then
ShowMessage('Процессы удалены и нельзя изменить приоритет!') else
try
//Назначить приоритет по индексу ComboBox,
//используя ссылку коллекции потоков
TMyThread(ListProcess.Items[ strtoint((TCombo.parent.Controls[0] as TLabel).Caption)-1
]).setPriory(TCombo.ItemIndex) ; StatusBar1.Panels[1].Text := 'Изменение приоритета';
//Сообщение об индексе текущего приоритета
StatusBar1.Panels[2].Text := inttostr(ord( TMyThread(ListProcess.Items[
strtoint((TCombo.parent.Controls[0] as TLabel).Caption)-1 ]).Priority
));
finally threadlist.UnlockList;
end;
end;
end.
49
Для заметок
_________________________________________________________________________________________________
50