Форум: "WinAPI";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];
ВнизГрадиентный прогрес в отдельном потоке Найти похожие ветки
← →
mambo © (2009-11-18 12:21) [0]Нужна помощь знающих потоки. Хочу сделать градиентный прогресс бар написал код. Так как ресурсы машины уходят на его работу переписал с созданием отдельного потока, но прогрес перестал прорисовыватся.
Помогите, где моя ошибка.
Класс прогреса:unit MyVisualClasess;
interface
uses
Classes, SysUtils, StdCtrls, ExtCtrls, RzPanel,Forms, Controls,
Windows;
type
TMyUnlimProgress = class(TThread)
private
FImage : TImage;
FProgrPan : TPanel;
FCaption : TCaption;
FLabel : TLabel;
FStop : boolean; // Признак остановки
FWay : Boolean; // направление движения, true - вправо
FLengthProgr : Integer; // Счетчик длины градиента
FSleep : Integer; // Скорость градиента (задержка)
FWidthPrgLine :integer;// Довжина градієнту
procedure CreateComponent (aOwner: TComponent; aWinControl: TWinControl);
protected
procedure Execute; override;
procedure ThreadStop;
public
constructor Create(aOwner: TComponent; aWinControl: TWinControl);
end;
implementation
{ TMyUnlimProgress }
constructor TMyUnlimProgress.Create(aOwner: TComponent; aWinControl: TWinControl);
begin
inherited Create(true); //Созданный поток создается в приостановленном состоянии
FreeOnTerminate := True; //Поток освободит ресурсы при окончании работы
Self.Priority := tpHighest; //Очень высокий приоритет
CreateComponent (aOwner,aWinControl);
Resume;
end;
procedure TMyUnlimProgress.CreateComponent(aOwner: TComponent;
aWinControl: TWinControl);
begin
FCaption:= " Мой прогресс... ";
FProgrPan:= TPanel.Create(AOwner);
with FProgrPan do begin
Top:= (aWinControl.Height div 2)- 50;
Height:= 30;
Left:= (aWinControl.Width div 2)- 125;
Width:= 250;
Parent:= aWinControl;
Visible:= true;
end;
FLabel:= TLabel.Create(aOwner);
with FLabel do begin
Align:= alTop;
Caption:= FCaption;
Parent:= FProgrPan;
end;
FImage:= TImage.Create(AOwner);
with FImage do begin
Align:= alClient;
Parent:= FProgrPan;
end;
FLengthProgr:= 0;
FSleep:= 30;
FWidthPrgLine:= 100;
Fstop:= false;
FWay:= true;
end;
procedure TMyUnlimProgress.Execute;
var
HandleChange: THandle; //Handle создаваемого объекта для ожидания события
i,j,n : Longint;
v_stmove : Boolean;
begin
try
//-- Цикл, пока для потока не будет выдана команда Terminate
while not Terminated do
begin
if FWay then begin
v_stmove:= false;
i:= 1; j:=1;
while (i < FImage.Width+FWidthPrgLine+1) or (not Terminated) do begin
if FLengthProgr <= FWidthPrgLine then begin
Inc(FLengthProgr);
end
else begin
v_stmove:= true;
FLengthProgr:= 0;
end;
while (j < FImage.Height - 1) or (not Terminated) do begin
if v_stmove then
FImage.Canvas.Pixels[i-FWidthPrgLine-1,j]:= $FFFFFF;
for n := FWidthPrgLine downto 1 do begin
FImage.Canvas.Pixels[i-n,j] := RGB((255*n div FWidthPrgLine),(255*n div FWidthPrgLine),255);
end;
inc(j);
end;
sleep(FSleep);
inc(i);
end;
FWay:= false;
end;
// move from right to left
{else begin
v_stmove:= true;
FLengthProgr:= 0;
i:= FImage.Width;
while i > -(FWidthPrgLine+1) do begin
if FLengthProgr <= FWidthPrgLine then begin
Inc(FLengthProgr);
end
else begin
v_stmove:= true;
FLengthProgr:= 0;
end;
for j:=1 to FImage.Height - 1 do begin
if v_stmove then begin
FImage.Canvas.Pixels[i+FWidthPrgLine+1,j]:= $FFFFFF;
end;
for n := 1 to FWidthPrgLine do begin
FImage.Canvas.Pixels[i+n,j] := RGB((255*n div FWidthPrgLine),(255*n div FWidthPrgLine),255);//a[n];
end;
end;
sleep(FSleep);
dec(i);
end;
FWay:= true;
end; }
// end move from right to left
end;
finally
end;
Synchronize(ThreadStop);
end;
procedure TMyUnlimProgress.ThreadStop;
begin
FImage.Free;
FLabel.Free;
FProgrPan.Free;
end;
end.
Вызов из главной формы:form1.Tag := Integer(TMyUnlimProgress.Create(self,form1));
остановка потокаif Assigned(TMyUnlimProgress(form1.Tag)) then
TMyUnlimProgress(form1.Tag).Terminate;
form1.Tag := 0;
← →
brother © (2009-11-18 12:26) [1]> Так как ресурсы машины уходят на его работу переписал с
> созданием отдельного потока, но прогрес перестал прорисовыватся.
чего куда уходит?) зачем отдельный поток?
← →
mambo © (2009-11-18 13:06) [2]Если точнее сказать, то просто выполнение программы уходит в ветку работы прогреса и соответственно пока он не остановится ничего далее работать не будет
← →
clickmaker © (2009-11-18 13:11) [3]> Так как ресурсы машины уходят на его работу
когда ресурсы уходят на "шашечки", а не на "ехать" - это не есть гут.
проще всего в рабочий цикл вставить Application.ProcessMessages, и все делать в основном потоке, либо вынести работу в отдельный поток и обновлять прогресс посылкой сообщения
← →
mambo © (2009-11-18 13:25) [4]
> проще всего в рабочий цикл вставить Application.ProcessMessages,
> и все делать в основном потоке, либо вынести работу в отдельный
> поток и обновлять прогресс посылкой сообщения
С Application.ProcessMessages не проходит уже пробовал :-(. Поэтому то и пробую сделать в отдельном потоке.
← →
brother © (2009-11-18 13:26) [5]а что не работает?
← →
mambo © (2009-11-18 15:15) [6]в данном варианте не происходит прорисовка FImage.Canvas. Цикл работает
← →
clickmaker © (2009-11-18 15:48) [7]> не происходит прорисовка FImage.Canvas
ну так надо FImage.Update сказать или Refresh
← →
Егорка (2009-11-18 17:39) [8]Удалено модератором
Примечание: Offtopic
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.062 c