Property ProgressBar:TProgressBar

write FProgressBar;

procedure DisplayProgress;

protected

procedure Execute; override;

procedure Paint;

end;

Implementation

uses Unit28;

constructor TPaintThread.InitColor (nColor:TColor);

begin

Fcolor:=nColor;

end;

procedure TPaintThread.DisplayProgress;

begin

FprogressBar.Position:=y;

end;

procedure TPaintThread.Paint;

var j: Integer;

begin

for j:=0 to 250 do begin

x:=j;

Form1.Canvas.Pixels[x,y]:=FColor;

end;

end;

procedure TPaintThread.Execute;

var i: Integer;

begin

repeat

for i:=0 to Form1.ClientHeight do begin

y:=i;

Synchronize(DisplayProgress);

Synchronize(Paint);

end;

until Terminated;

end;

End.

unit Unit28;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ComCtrls, MyThread3;

Type

TForm1 = class(TForm)

TrackBar1: TTrackBar;

TrackBar2: TTrackBar;

TrackBar3: TTrackBar;

BitBtn1: TBitBtn;

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

CheckBox3: TCheckBox;

ProgressBar1: TProgressBar;

ProgressBar2: TProgressBar;

ProgressBar3: TProgressBar;

procedure CheckBox1Click (Sender: TObject);

procedure TrackBar1Change (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure FormMouseDown (Sender: TObject; Button:

TMouseButton; Shift: TShiftState; X, Y: Integer);

public

PT: array [1..3] of TPaintThread;

end;

var Form1: TForm1;

Implementation

{$R *.dfm}

procedure TForm1.CheckBox1Click (Sender: TObject);

begin

Form1.Canvas.Lock;

if (Sender as TCheckbox).Checked then

PT [(Sender as TCheckbox).Tag].Resume

else PT [(Sender as TCheckbox).Tag].Suspend;

Form1.Canvas.UnLock;

end;

procedure TForm1.TrackBar1Change (Sender: TObject);

begin

PT [(Sender as TTrackBar).Tag].Priority:=

TThreadPriority ((Sender as TTrackBar).Position);

end;

procedure TForm1.FormCreate (Sender: TObject);

begin

PT [1]:= TPaintThread.Create (true);

PT [2]:= TPaintThread.Create (true);

PT [3]:= TPaintThread.Create (true);

PT[1].InitColor(clRed);

PT[2].InitColor(clBlue);

PT[3].InitColor(clGreen);

ProgressBar1.Max:=Form1.ClientHeight;

ProgressBar2.Max:=Form1.ClientHeight;

ProgressBar3.Max:=Form1.ClientHeight;

ProgressBar1.Step:=Form1.ClientHeight div 10;

ProgressBar2.Step:=Form1.ClientHeight div 10;

ProgressBar3.Step:=Form1.ClientHeight div 10;

PT[1].ProgressBar:=ProgressBar1;

PT[2].ProgressBar:=ProgressBar2;

PT[3].ProgressBar:=ProgressBar3;

end;

procedure TForm1.FormMouseDown (Sender: TObject;

Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Canvas.Lock;

try

Canvas.Pen.Color:= Color;

Canvas.Brush.Color:= Color;

Canvas.Ellipse (x - 30, y - 30, x + 30, y + 30);

finally

Canvas.Unlock;

end;

end;

End.

Результат решения примера приводится на рис. 64 (показаны установки приоритетов, обеспечивающие достаточно надежную работу приложения).

 

Рис. 64. Вариант решения примера 28.

В примере создается массив PT из трех потоков. Цвет закраски прямоугольной области задается с помощью вызова конструктора InitColor. Разделение общих ресурсов, используемых потоками обеспечивается методом Synchronize. Для ускорения работы синхронизируется работа не каждого доступа к канве по изменению цвета пиксела (Pixels[x,y]), а только очередной дисплейной строки. Можно попытаться синхронизировать доступ к каждому пикселу, возможно, это обеспечит более надежную работу (но замедлится работа приложения). Надежной работы данной программы можно добиться, используя методы блокировки канвы, как это было применено в примере выше. Далее для этого случая приводится код модуля, в котором объявлен поток (код основного модуля не изменился по сравнению с предыдущим примером).

unit MyThread3_1;

Interface

uses Classes, Graphics, ComCtrls;

type

TPaintThread = class(TThread)

private

FColor:TColor;

FProgressBar:TProgressBar;

public

constructor InitColor(nColor:TColor);

property ProgressBar:TProgressBar

write FProgressBar;

protected

procedure Execute; override;

end;

Implementation

uses Unit28_1;

constructor TPaintThread.InitColor (nColor:TColor);

begin

Fcolor:=nColor;

end;

procedure TPaintThread.Execute;

var x,y: Integer;

begin

repeat

for y:=0 to Form1.ClientHeight do begin

FprogressBar.Position:=y;

Form1.Canvas.Lock;

try

for x:=0 to 250 do

Form1.Canvas.Pixels[x,y]:=FColor;

finally

Form1.Canvas.UnLock;

end;

end;

until Terminated;

end;

End.

Единственно, что можно отметить для данного варианта, это то, что наблюдается некоторое притормаживание, когда включается в работу основной поток – рисование круга (или происходит нажатие на кнопку выхода из приложения). Это связано с тем, что блокируется не одна операция Pixels[x,y], а весь цикл закраски пикселов в данной строке.