unit Progbox;

interface

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

  {v0.39}UtlType, {/v0.39 MyType, MyLib, }ListType, Listu, Msgu;

type
  TProgressForm = class(TForm)
    Gauge: TGauge;
    ProgressEdit: TEdit;
    DoBtn: TButton;
    procedure DoBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  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;

{v0.50}
const
  fDestroyed: TProgressForm = nil;{/v0.50}
  fProcessingMessages:  boolean = false;

procedure ProcessMessages;
begin
  if fProcessingMessages then
    exit;
  fProcessingMessages := true;
  try
    Application.ProcessMessages;
  finally
    fProcessingMessages := false;
  end;
end;
{/v0.50}

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;
  {v0.50}
  fDestroyed := nil;
  {/v0.50}

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

  if AProgressBox = {v0.39}pointer(1){/v0.39 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;
      {v0.50}
      fDestroyed := f;
      {/v0.50}
      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;
      {v0.39}
      {v0.50}
      ProcessMessages;
      {/v0.50
      Application.ProcessMessages;}
      {/v0.39}
    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;
  {v0.50}
  {/v0.50
  Application.ProcessMessages;}

  if (f <> nil){v0.50} and (f <> fDestroyed){/v0.50} 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;

procedure TProgressForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
   {v0.39}
   Action := caNone;
   {/v0.39}
end;

{v0.48}
initialization
  SetMsgProc(mtProgressBox, @ProgressBox);
{/v0.48}
end.
