методички / 4045 ЭИ
.pdfПриложение 2
type
// Запись для асинхронного обмена данными от потока к интерфейсной панели
TDataVision = Record
FCounter: Integer; // Текущий счетчик процесса FCountTo: Integer; // Конечный счетчик процесса
PctDone: Extended; // Oтносительная позиция процесса между start и end Step: LongInt; // Шаг прогресс-линии
Interval: integer; // Интервал обращения процесса к изменению данных end;
{Класс независимого потока TMyThread}
TMyThread = class(TThread) private
StartTime,EndTime: TDateTime; // Временные интервалы процесса public
DataVision: TDataVision;
Position: extended; // Расчет позиции ProgressBar
btReadOn: boolean; |
// Флаг разрешения чтения данных |
|
ID: integer; |
// Идентификатор потока |
|
mRep: TMemo; |
|
// Отчет процессов по завершению |
pause: boolean; |
// Приостановка потока (имитация Suspend) |
|
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;
31
Приложение 2
end;
procedure TCollthreadlist.ClearThread; var i: integer;
begin
for i:=0 to self.LockList.Count-1 do // Проход по коллекции Tthread(LockList.Items[i]).Destroy; // Освобождение ресурса
self.LockList.Clear;
end;
constructor TMyThread.Create(Suspended_: Boolean; id_:integer; // id процесса priory: integer; // Приоритет
DataVision_: TDataVision; // Обмен mem_: TMemo); // Объект вывода отчета
begin
inherited Create(Suspended_); btReadOn := false;
pause:= Suspended_; DataVision:=DataVision_; id := id_; // идентификатор
{Если FreeOnTerminate имеет значение True, то VCL автоматически разрушает объект потока при его завершении}
FreeOnTerminate := false; // Объект будет разрушаться программно // для получения признака not Assigned()
// Уровень приоритета 0-6
// Memo для формирования отчета
Procedure TMyThread.starTHread; begin
StartTime := Time;
if Suspended then begin
btReadOn := true; // старт + разрешение чтения данных
Start;
end;
pause := false; end;
Procedure TMyThread.setPriory(set_: integer); begin
Priority := CThreadPriority[set_]; // тип приоритета end;
procedure TMyThread.Execute; begin
with DataVision do begin
while (FCounter < FCountTo) and not(self.Terminated) do begin
repeat
if self.Terminated then exit;
if pause then // Эмуляция Suspend := true; sleep(1);
until not pause;
if FCounter mod Interval = 0 then DoWork; // Асинхронный вывод
Inc(FCounter);
end;
EndTime := Time;
32
Приложение 2
//Завершить оформление вывода if not(self.Terminated) then begin
Dec(FCounter);
DoWork; // Завершение вывода данных end;
//Синхронизированный отчет потока
Synchronize(@Report); // о затраченном времени
end;
end;
// Асинхронный вывод данных на интерфейсную панель procedure TMyThread.DoWork;
begin
btReadOn := false; // блокировать чтение данных потока with DataVision do begin
// Изменить данные процесса
PctDone := (FCounter / FCountTo); // относительная часть выполненного Position := Round(Step * PctDone); // задания
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';
tpNormal: result:='Normal'; tpLower: result:='Lower'; tpLowest: result:='Lowest'; tpIdle: result:='Idle';
end;
end;
end.
Модуль классов интерфейсов управления потоком. Асинхронный обмен осуществляет про-
цедура IdleEventHandler(Sender: TObject; var Done: Boolean), которая присваивается системному обработчику события OnIdle на время «простоя» системы. Процедура выполняется с наименьшим приоритетом фона, «просматривает» список потоков и выводит измененные данные на интерфейсную панель. Таким образом, в очереди на вывод визуальных стоит единственный поток «свободного времени», когда как остальные «рабочие» потоки не прерывают на вывод визуальных данных собственные задания.
{АСИНХРОННЫЙ ОБМЕН ДАННЫМИ С VCL; форма интерфейсных элементов потоков (процессов); методы взаимодействия потоков и интерфейсов; управление потоками через интерфейсы}
unit Unit1;
33
Приложение 2
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Grids, Spin,unit2;
type
{ TForm1 }
TForm1 = class(TForm) btSaveComponentInStream: TButton; btStart: TButton;
btStop: TButton; 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; Panel1: TPanel; Panel2: TPanel;
ProgressBar1: TProgressBar; ScrollBox1: TScrollBox; SpinEdit1: TSpinEdit; StatusBar1: TStatusBar; StringGrid1: TStringGrid;
procedure btSaveComponentInStreamClick(Sender: TObject); procedure btStartClick(Sender: TObject);
procedure btStopClick(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;
34
Приложение 2
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;
end;
procedure TForm1.Start_Idle; // Старт - Фоновый опрос данных вывода потоков begin
// Назначить обработчик событию процесса Idle Application.OnIdle := @IdleEventHandler;
end;
// Стоп Idle
procedure TForm1.Stop_Idle; begin
// Отменить обработку события процесса Idle Application.OnIdle := nil;
Label4.Caption:='---'; end;
// Запись панели управления в файловый поток (создание шаблона интерфейса) procedure TForm1.btSaveComponentInStreamClick(Sender: TObject);
var
Stream: TFileStream ; St: TStringList;
S: String;
35
Приложение 2
begin
Stream := TFileStream.Create( 'CompFile', fmCreate ) ; try
Stream.WriteComponent( GroupBox2 ); Stream.WriteComponent( Label1 ); // ID потока
Stream.WriteComponent( ComboBox1 ); // Управление приоритетом Stream.WriteComponent( Label2 ); // Процент выполнения задания Stream.WriteComponent( ProgressBar1 );// Линия прогресса
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.btStartClick(Sender: TObject);
var i: integer; begin
if (Assigned(ListProcess)) then begin if (ListProcess.Count=0) then
ShowMessage('Процессы еще не загружены!') else
if (TMyThread(ListProcess.Items[0]).pause) then // включаем процессы
begin
for i:=0 to ListProcess.Count-1 do // Эмуляция Suspended := false;
TMyThread(ListProcess.Items[i]).starTHread; StatusBar1.Panels[1].Text := 'Процессы включены'; btStart.Caption:='Стоп';
Start_Idle; // Старт асинхронного вывода end
else
//ShowMessage('Процессы уже включены и работают!') // выключаем процессы
begin
Stop_Idle; // Остановка асинхронного вывода for i:=0 to ListProcess.Count-1 do
// Эмуляция Suspended := true; TMyThread(ListProcess.Items[i]).pause:=true;
StatusBar1.Panels[1].Text := 'Процессы остановлены'; btStart.Caption:='Старт';
end end
else
ShowMessage('Процессы выключены (не выгружены в память)!');
36
Приложение 2
end;
// Остановка-удаление потоков
procedure TForm1.btStopClick(Sender: TObject); begin
if not(Assigned(ListProcess)) then
ShowMessage('Процессы уже выключены!') else
if (ListProcess.Count=0) then ShowMessage('Процессы еще не загружены!')
else
if (TMyThread(ListProcess.Items[0]).Suspended) then
ShowMessage('Процессы еще не запущены по кнопке «Старт»!') else
// выключаем-удаляем процессы begin
Stop_Idle; // Остановка асинхронного вывода // Освобождаем ресурсы от процесса threadlist.ClearThread;
StatusBar1.Panels[1].Text := 'Список процессов удален'; 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 );
threadlist := TCollthreadlist.Create; // Создать коллекцию потоков end;
// Загрузить цепь процессов и панелей управления (клонировать из файла) procedure TForm1.LoadComponentInStreamClick(Sender: TObject);
var
Stream : TFileStream ; GBox: TGroupBox; Lb1,Lb2: TLabel; CBox: TComboBox; PBar: TProgressBar; St: TStringList;
rect :TRect; i, itm :integer; DataVision: TDataVision;
begin
if threadlist.LockList.Count>0 then begin
ShowMessage('Процессы уже загружены!'); exit;
end;
// Очистить таблицу от интерфейсов предыдущей коллекции if StringGrid1.RowCount > 0 then begin
for i := 0 to StringGrid1.RowCount - 1 do
37
Приложение 2
StringGrid1.Objects[0,i].Destroy; StringGrid1.RowCount := 0;
end; btStart.Caption:='Старт';
ListProcess := threadlist.LockList; // Получить ссылку на коллекцию mfReport.Clear; // размещения потоков
// Подготовить данные визуального отображения with DataVision do begin
FCounter := 0; // Текущий счетчик процесса
Interval := 10000000; // Интервал обращения процесса к изменению данных
FCountTo := round(MAXINT/5); // Конечное число цикла Step := FCountTo div Interval; // Шаг прогресс-линии
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;
//...строки меню выбора приоритета
St := TStringList.Create; St.LoadFromStream(Stream);
//Строки меню в список выбора
CBox.Items.BeginUpdate; CBox.Items := St; CBox.Items.EndUpdate; CBox.ItemIndex := 0; Lb1.Caption := IntToStr(i+1);
//Назначить события отображения информации при выборе панели интерфейса и
//назначения приоритета потоку
GBox.ControlStyle := [csClickEvents]; GBox.OnClick := @GBoxClick;
(GBox.Controls[1] as TComboBox).OnChange := @ComboClick;
//Запись ID потока на панель интерфейса
GBox.Caption :='Id ' + inttostr(100+i);
itm := 1 + Random(6); // Случайный выбор приоритета
(GBox.Controls[1] as TComboBox).ItemIndex:=itm;
//Назначить интерфейсу владельца - таблицу строк
GBox.Parent := StringGrid1;
//Создать строку в таблице для размещения интерфейса
StringGrid1.RowCount:=StringGrid1.RowCount+1;
38
Приложение 2
//«Прямоугольник» в ячейке таблицы для размещения панели 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;
//Создать и добавить поток в коллекцию; DataVision - переменная для обмена
ListProcess.Add(TMyThread.Create(true,i+100,itm,DataVision,mfReport));
end; // for
StatusBar1.Panels[1].Text := 'Процессы загружены'; finally
Stream.Free ; // Освобождение ресурсов файлового потока end ;
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.
39
Приложение 3
МНОГОМЕРНЫЕ СВЯЗАННЫЕ ПОТОКИ
П3.1. Описание Основных Классов (Lazarus)
Программное описание класса потока и класса списка, хранящего указатели на экземпляры потока. Ознакомиться с примером, создать собственные экземпляры классов потока и списка (коллекции, цепи) хранения указателей на потоки. Вариант выполняемого задания потоком и его взаимодействие с VCL заявляется студентом, согласуется и утверждается преподавателем. Язык программирования выбирается студентом по желанию.
Модуль классов потока и списка ссылок на поток. Данные потока асинхронно считы-
ваются методом Idle с выводом на интерфейсную панель посредством переменной DataVision. Для запуска потока с панели управления, паузы и продолжения работы потока (по указанию пользователя) объявляется событие evs : TEvent, эмулирующее работу семафора. Кроме того, по завершению процедуры Execute поток запускает соседние процессы (открывает семафоры), находящиеся в ожидании при закрытом семафоре.
{AСИНХРОННЫЙ ОБМЕН ДАННЫМИ С VCL
связанные взаимодействием потоки через открытие/закрытие семафоров; коллекция-лист объектов потока}
unit Unit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,Dialogs,STDCTRLS,SyncObjs;
const
CThreadPriority: array[0..6] of TThreadPriority = ( tpTimeCritical, // Приоритет реального времени tpHighest,
tpHigher,
tpNormal, // Приоритет по умолчанию tpLower,
tpLowest,
tpIdle // процесс выполняется только тогда, когда система не занята
);
type
// Запись для асинхронного обмена данными от потока к интерфейсной панели
TDataVision = Record
FCounter: Integer; // Текущий счетчик процесса FCountTo: Integer; // Конечный счетчик процесса
PctDone: Extended; // Oтносительная позиция процесса между start и end Step: LongInt; // Шаг прогресс-линии
Interval: integer; // Интервал обращения процесса к изменению данных
//Коллекция, где регистрируется поток
ParentList: TList;
//Индекс узла коллекции, где регистрируется поток idx: integer;
end;
{Класс независимого потока TMyThread}
TMyThread = class(TThread) private
40