Управление скоростью работы потоков

Рассмотрим на примере влияние приоритета на скорость работы потока. Создадим приложение, в котором два потока будут взаимодействовать с одним и тем же объектом типа Timage. Первый поток будет перекрашивать точку со случайными координатами в белый цвет, а второй – в черный.

Добавим в проект два потока с именами time1 и time2. На форму поместим объект типа Timage и кнопку. Описание обоих потоков аналогично и выглядит следующим образом:

unit thr1;

interface

uses

Classes, ExtCtrls, Graphics, forms, windows;

type

time1 = class(TThread)

private

{ Private declarations }

procedure UpdateTimer;

protected

procedure Execute; override;

end;

implementation

uses main;

procedure time1.updatetimer;

var x,y:integer;

begin

with form1.Image1 do

begin

x:=random(width);

y:=random(height);

Canvas.Pixels[x,y]:=clWhite;

{ для второго потока clBlack }

end

end;

procedure time1.Execute;

begin

{ Place thread code here }

repeat

synchronize(updatetimer);

application.ProcessMessages

until terminated

end;

end.

В основной программе, как и обычно, добавляем ссылки на модули потоков в оператор USES и объявляем две глобальные переменные-потоки:

var

Form1: TForm1;

thread1:time1;

thread2:time2;

При создании формы следует создать потоки, но не запускать их (параметр True метода Create):

procedure TForm1.FormCreate(Sender: TObject);

begin

doublebuffered:=true;

thread1:=time1.Create(true);

thread1.FreeOnTerminate:=true;

thread2:=time2.Create(true);

thread2.FreeOnTerminate:=true

end;

В обработчике нажатия кнопки зальем всю картинку черным цветом и запустим оба потока (метод Resume):

procedure TForm1.Button1Click(Sender: TObject);

begin

with image1.Canvas do

begin

brush.Color:=clBlack;

fillrect(image1.ClientRect)

end;

thread1.Resume;

thread2.Resume

end;

После щелчка по кнопке объект Image1 начинает равномерно заполняться белыми и черными точкам. Их количество одинаково, поэтому в целом картинка выглядит равномерно заполненной.

Теперь добавим на форму два компонента типа TRadioGroup. Зададим в каждом из них семь вариантов (свойство Columns) и пронумеруем варианты от 1 до 7 (свойство Items). Установим текущим элементом первый (свойство ItemIndex установить в ноль). Эти компоненты будут переключать приоритеты работы потоков. Поскольку оба потока переключаются аналогично, следует написать отдельную процедуру, чтобы избежать повторения кода:

procedure SetPriority(i:longint;t:tThread);

begin

case i of

0: t.Priority:=tpIdle;

1: t.Priority:=tpLowest;

2: t.Priority:=tpLower;

3: t.Priority:=tpNormal;

4: t.Priority:=tpHigher;

5: t.Priority:=tpHighest;

6: t.Priority:=tpTimeCritical

end

end;

На вход процедуре SetPriority подаются целое число – номер выбранного пункта в компоненте TRadioGroup и поток, приоритет которого меняется.

В обработчиках события OnClick объектов RadioGroup пишем:

procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

SetPriority(RadioGroup1.ItemIndex,thread1)

end;

procedure TForm1.RadioGroup2Click(Sender: TObject);

begin

SetPriority(RadioGroup2.ItemIndex,thread2)

end;

Теперь, запустив программу, попробуем изменять приоритеты потоков. Четко видно, что при снижении приоритета "белого" потока картинка заполняется черными точками и наоборот, пир торможении "черного" картинка белеет.