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;