Fórum Progress Animado #263784

unit unt_VDOPrintProgress;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls;

type
  Tfrm_VDOPrintProgress = class(TForm)
    tim_printing: TTimer;   
    bvl_main: TBevel;    
    lbl_printing: TLabel;    
    ptb_printing: TPaintBox; 
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tim_printingTimer(Sender: TObject);
    procedure ptb_printingPaint(Sender: TObject);
  private
    { Private declarations }
    Frames: TBitmap;
    FrameIndex: Byte;
  public
    { Public declarations }
  end;

var
  frm_VDOPrintProgress: Tfrm_VDOPrintProgress;

implementation

{$R *.dfm}
{$R VDOPrintProgress.res}

procedure Tfrm_VDOPrintProgress.FormCreate(Sender: TObject);
begin
  Frames := TBitmap.Create;
  Frames.LoadFromResourceName(HInstance,´PRINTING´);
  FrameIndex := 0;
end;

procedure Tfrm_VDOPrintProgress.FormShow(Sender: TObject);
begin
  DoubleBuffered := True;
  tim_printing.Enabled := True;
end;

procedure Tfrm_VDOPrintProgress.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Frames.Free;
end;

procedure Tfrm_VDOPrintProgress.tim_printingTimer(Sender: TObject);
begin
  ptb_printing.Refresh;
  if FrameIndex > 5 then FrameIndex := 0;
end;

procedure Tfrm_VDOPrintProgress.ptb_printingPaint(Sender: TObject);
begin
  with ptb_printing.Canvas do
  begin
    Brush.Color := Color;
    FillRect(Bounds(0, 0, 32, 32));
    BrushCopy(Bounds(0, 0, 32, 32), Frames, Bounds(FrameIndex * 32, 0, 32, 32), clFuchsia);
  end;
end;

end.

...
uses
  Forms,
  Unit1 in ´Unit1.pas´ ;

{$R *.res}
{$R SeuArquivo.res}
 
begin
  Application.Initialize;
...

...
var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R SeuArquivo.res}
 
procedure TForm1...

procedure TForm1.Button1Click(Sender: TObject);
begin
  form2.show;
  Processa;
  Form2.Close;
end;

procedure TForm1.Processa;
var
  i, j, h: integer;
begin
  h := 0;
  for i := 0 to 10000 do
    for j := 0 to 200000 do
      inc(h);
  Caption := IntToStr(h);
end;

procedure TForm1.Processa;
var
  i, j, h: integer;
begin
  h := 0;
  for i := 0 to 10000 do
    for j := 0 to 200000 do
      begin
        inc(h);
        Application.ProcessMessages;
      end;
  Caption := IntToStr(h);
end;

Se o processamento for no servidor, por exemplo, vc envia a consulta e enquanto aguarda o retorno do SGBD vc exibe a animação, não haverá comprometimento... 

ah, depois quando chegar no trampo posto um exemplo de barra de progressao utilizando Thread .. 

unit UProgress;

interface
  uses
    classes, windows, uscript, sysutils, unit2;
  type
    TThreadBanco = class (TThread)
    public
      Constructor create;
    private

    protected
      procedure Execute; override;
end;


implementation

constructor TThreadBanco.create;
begin
  inherited Create(False);
end;

procedure TThreadBanco.Execute;
var
  x: integer;
begin
  form2.show;
  //aqui vai o codigo a ser executado pela thread
  for x:= 0 to 99999 do
    form2.Gauge1.progress:= x; 
 form2.close;
end;

...

procedure TForm1.Button6Click(Sender: TObject);
var
  T: TThreadBanco;
begin
  T:= TThreadBanco.create;
  T.WaitFor;
  T.Free;
end;

 //aqui vai o codigo a ser executado pela thread 
  for x:= 0 to 99999 do 

 //aqui vai o codigo a ser executado pela thread 
  for x:= 0 to 99999 do 

for x:= 0 to VariaveldoTipostringlist.count - 1 do ;
           begin
             qy.Close;
             qyclear;
             qy.sql.text:= VariaveldoTipostringlist.strings[x];
             qy.Open
           end;