Текущий архив: 2013.03.22;
Скачать: CL | DM;

Вниз

Градиентный прогрес в отдельном потоке   Найти похожие ветки 

← →
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 вся ветка

Текущий архив: 2013.03.22;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.049 c