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], а весь цикл закраски пикселов в данной строке.