source: tags/2.10/UWaitingDialog.pas

unit UWaitingDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls, StdCtrls, ExtCtrls;

type
  TMetoda = procedure of object;

  TWaitingTask = class(TThread)
    procedure Execute; override;
  public
    Cislo: Integer;
    Nazev: string;
    Metoda: TMetoda;
  end;

  TWaitingDialog = class(TForm)
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    ListView1: TListView;
    ImageList1: TImageList;
    Label2: TLabel;
    Timer1: TTimer;
    Label3: TLabel;
    Animate1: TAnimate;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FPozice: Real;
    Ulohy: array of record
      Operace: TMetoda;
      Primo: Boolean;
    end;
    Chyba: Integer;
    Uloha: TWaitingTask;
    WindowList: Pointer;
    Zacatek: TDateTime;
    procedure NastavPozici(NovaPozice: Real);
  public
    Terminate: Boolean;
    property Pozice: Real write NastavPozici;
    procedure PridejUlohu(Nazev: string; Metoda: TMetoda; Primo: Boolean=False);
    procedure Start;
    procedure Stop;
    { Public declarations }
  end;

var
  WaitingDialog: TWaitingDialog;

implementation

{$R *.dfm}

procedure TWaitingTask.Execute;
begin
  try
    try
      Metoda;
    except
      raise Exception.Create('V úloze "' + Nazev + '" došlo k vyjímce!');
    end;
  finally
    Terminate;
  end;
end;

procedure TWaitingDialog.NastavPozici(NovaPozice: Real);
begin
  if (NovaPozice<0) then NovaPozice:= 0;
  if (NovaPozice>100) then NovaPozice:= 100;
  if not ProgressBar1.Visible then ProgressBar1.Show;
  ProgressBar1.Position:= Round(NovaPozice);
  FPozice:= NovaPozice;
end;

procedure TWaitingDialog.PridejUlohu(Nazev: string; Metoda: TMetoda; Primo: Boolean=False);
var
  Novy: TListItem;
begin
  ListView1.Items.BeginUpdate;
  Novy:= ListView1.Items.Add;
  with Novy do begin
    Caption:= Nazev;
    ImageIndex:= 2;
  end;
  SetLength(Ulohy,Length(Ulohy)+1);
  Ulohy[High(Ulohy)].Operace:= Metoda;
  Ulohy[High(Ulohy)].Primo:= Primo;
  ListView1.Items.EndUpdate;
end;

procedure TWaitingDialog.Start;
var
  I: Integer;
begin
  try
  Terminate := False;
  Chyba:= 0;
  WindowList := DisableTaskWindows(0);
  Height:= 90+19*ListView1.Items.Count;
  Zacatek:= Now;
  //Show;
  Timer1.Enabled:= True;
//  Timer1Timer(Self);
  for I:= 0 to High(Ulohy) do begin
    ListView1.Items.Item[I].ImageIndex:= 1;
    Label3.Caption:= '';
    ProgressBar1.Position:= 0;
    if Ulohy[I].Primo then Ulohy[I].Operace else begin
      Uloha := TWaitingTask.Create(True);
      with Uloha do begin
        Metoda:= Ulohy[I].Operace;
        Nazev:= ListView1.Items.Item[I].Caption;
        Cislo:= I;
        Resume;
        while not Terminated do Application.ProcessMessages;
        WaitFor;
        Free;
      end;
    end;
    ProgressBar1.Hide;
    ListView1.Items.Item[I].ImageIndex:= 0;
    if Chyba>0 then Break;
  end;
  finally
    Timer1.Enabled:= False;
    EnableTaskWindows(WindowList);
    if Visible then begin
      WaitingDialog.Hide;
    end;
    SetLength(Ulohy,0);
    ListView1.Items.BeginUpdate;
    ListView1.Clear;
    ListView1.Items.EndUpdate;  
  end;
end;

procedure TWaitingDialog.Timer1Timer(Sender: TObject);
begin
  if not Visible then begin
    Show;
  end;
  if ProgressBar1.Position>4 then
  Label3.Caption := TimeToStr((Now-Zacatek)/FPozice*(100-FPozice));
end;

procedure TWaitingDialog.FormCreate(Sender: TObject);
begin
  Animate1.FileName := ExtractFileDir(Application.ExeName)+ '\horse.avi';
  Animate1.Active := True;
end;

procedure TWaitingDialog.Stop;
begin
  Terminate := True;
end;

procedure TWaitingDialog.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Terminate := True;
end;

end.