unit Progbox;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Gauges,

  MyType, MyLib, ListType, Listu;

type
  TProgressForm = class(TForm)
    Gauge: TGauge;
    ProgressEdit: TEdit;
    DoBtn: TButton;
    procedure DoBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FCanceled:boolean;
    IsInProgressBox:boolean;
  end;

var
  ProgressForm: TProgressForm;

{const in MyType
  pbShow = 1;
  pbHide = 2;
  pbUpdate = 3;
  pbMsg = 4;
  pbCancel = 5;
  pbCanceled = 6;
  pb}

function ProgressBox(var AProgressBox:TProgressBox; what:TProgressBoxAction;
  const Msg:string; X,Y:longint):TProgressBoxResult;

implementation
const
  pbs:TLst = nil;
  StayOnTop:boolean = false;

function ProgressBox(var AProgressBox:TProgressBox; what:TProgressBoxAction;
  const Msg:string; X,Y:longint):TProgressBoxResult;
var
  i,j:longint;
  f:TProgressForm absolute AProgressBox;
  f1:TProgressForm;
begin
  ProgressBox := 0;

  case what of
    pbStayOnTopOn: begin
      StayOnTop := true;
      exit;
    end;
    pbStayOnTopOff: begin
      StayOnTop := false;
      exit;
    end;
  end;

  if AProgressBox = DefaultProgressBox then begin
    if (what <> pbShow) then begin
      if ((pbs = nil) or (ListCount(pbs) = 0)) then
        exit;
      AProgressBox := ListAt(pbs, ListCount(pbs) - 1);
    end;
  end;

  ProgressBox := 0;
  if (f = nil) and (what <> pbShow) then begin
    ProgressBox := -1;
    exit;
  end;
  if (what <> pbShow) then begin
    if f.IsInProgressBox then
      exit;
    f.IsInProgressBox := true;
  end;

  case what of
    pbShow: begin
      f := TProgressForm.Create(Application);
      {ProgressForm.Show;
      ProgressForm.ProgressEdit.Text := Msg;}
      f.Gauge.Progress  := 0;
      if StayOnTop then
        f.FormStyle := fsStayOnTop;
      if f <> nil then begin
        if (pbs <> nil) and (ListCount(pbs) > 0) then begin
          f1 := ListAt(pbs, ListCount(pbs) - 1);
          f1.Hide;
        end;

        f.ProgressEdit.Text := Msg;
        f.Show;
        {f.BringToFront;}
        if pbs = nil then begin
          ListInit(ltPointers, NoListInfo, pbs);
        end;
        if pbs <> nil then begin
          ListAdd(pbs, f);
        end;

      end else
        ProgressBox := -1;
    end;

    pbHide: begin
      {ProgressForm.Hide;}
      if pbs <> nil then begin
        if ListIndexOf(pbs, f) >= 0 then
          ListRemove(pbs, f);
        if ListCount(pbs) > 0 then begin
          f1 := ListAt(pbs, ListCount(pbs) - 1);
          f1.Show;
        end;
      end;
      f.Free;
      f := nil;
    end;

    pbUpdate: begin
      i := f.Gauge.Progress;
      if (y <> 0) and (x <= y) then begin
        j := round(abs(100*x/y));
        if j <> i then
          f.Gauge.Progress := j;
      end;
      if Msg <> '' then
        f.ProgressEdit.Text := Msg;
      if f.FCanceled then
        ProgressBox := -1;
    end;

    pbMsg: begin
      f.ProgressEdit.Text := Msg;
    end;

    pbCancel: begin
      f.FCanceled := true;
    end;

    pbCanceled : begin
      ProgressBox := longint(f.FCanceled);
    end;
    pbTop : begin
      f.BringToFront;
    end;
  end;
  Application.ProcessMessages;

  if f <> nil then begin
    f.IsInProgressBox := false;
  end;
end;


{$R *.DFM}

procedure TProgressForm.DoBtnClick(Sender: TObject);
begin
  FCanceled := true;
end;

procedure TProgressForm.FormCreate(Sender: TObject);
begin
  FCanceled:=false;
  IsInProgressBox:= true;
end;

end.
