www.pudn.com > DriveRescuev1.8.zip > statusdlg.pas

unit statusdlg; 
 
interface 
 
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, 
  Buttons, ExtCtrls, ComCtrls; 
 
type 
  TStatusDialog = class(TForm) 
    CancelBtn: TButton; 
    Bevel1: TBevel; 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Label4: TLabel; 
    ProgressBar1: TProgressBar; 
    Label5: TLabel; 
    procedure CancelBtnClick(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
  private 
    { Private declarations } 
    FLastProgressUpdateTime: longword; 
    FLastProgressTickCount: longword; 
    FProgressPosTime: longword; 
    FShowTime: boolean; 
    FTimeForUserUpdate: boolean; 
  public 
    UserCancel: boolean; 
    ProgressPos: longword; 
    ProgressMax: longword; 
    ProgressStep: longword; 
    ProgressUpdateInterval: longword; 
    procedure SetStatus(title, text1, text2, text3, text4: shortstring; 
      showprogress: boolean; showtime: boolean); 
    function TimeForUserUpdate: boolean; 
    procedure UpdateStatus(title, text1, text2, text3, text4: shortstring); // updates non-empty strings only 
    procedure ProgressStopTime; 
    procedure ProgressStepIt; 
    procedure ProgressUpdateTime; 
    { Public declarations } 
  end; 
 
var 
  StatusDialog: TStatusDialog; 
 
implementation 
 
{$R *.DFM} 
 
 
 
procedure TStatusDialog.SetStatus(title, text1, text2, text3, text4: shortstring; 
  showprogress: boolean; showtime: boolean); 
begin 
  if showprogress then 
  begin 
    label5.caption:=''; 
    ProgressBar1.Position:=0; 
    ProgressBar1.show; 
    ProgressPos:=0; 
 
    FLastProgressUpdateTime:=0; 
    FLastProgressTickCount:=0; 
    FTimeForUserUpdate:=TRUE; 
  end else ProgressBar1.hide; 
  FShowTime:=showtime; 
  caption:=title; 
  Label1.caption:=text1; 
  Label2.caption:=text2; 
  Label3.caption:=text3; 
  Label4.caption:=text4; 
end; 
 
procedure TStatusDialog.ProgressStopTime; 
begin 
  FLastProgressTickCount:=0; 
end; 
 
procedure TStatusDialog.ProgressStepIt; 
var 
  steptime: longword; 
  update: boolean; 
begin 
  inc(ProgressPos, ProgressStep); 
  update:=FALSE; 
  if FLastProgressUpdateTime = 0 then 
  begin 
    update:=TRUE; 
  end else if gettickcount > (FLastProgressUpdateTime + ProgressUpdateInterval) then update:=TRUE; 
 
  if update then 
  begin 
    FTimeForUserUpdate:=TRUE; 
    FLastProgressUpdateTime:=gettickcount; 
 
    ProgressBar1.position:=round(ProgressPos/ProgressMax*100); 
    if FShowTime then 
    begin 
      if FLastProgressTickCount = 0 then 
        FLastProgressTickCount:=gettickcount 
      else begin 
        if gettickcount > FLastProgressTickCount+5000 then 
        begin 
          steptime:=round((gettickcount-FLastProgressTickCount)/1000); 
          FLastProgressTickCount:=gettickcount; 
          inc(FProgressPosTime, steptime); 
          ProgressUpdateTime; 
        end; 
      end; 
    end;   
  end; 
end; 
 
function TStatusDialog.TimeForUserUpdate: boolean; 
var 
  needupdate: boolean; 
begin 
  if FTimeForUserUpdate then 
  begin 
    FTimeForUserUpdate:=FALSE; 
    result:=TRUE; 
    exit; 
  end; 
  needupdate:=FALSE; 
  if FLastProgressUpdateTime = 0 then 
  begin 
    needupdate:=TRUE; 
  end else if gettickcount > (FLastProgressUpdateTime + ProgressUpdateInterval) then needupdate:=TRUE; 
  if needupdate then 
  begin 
    FTimeForUserUpdate:=FALSE; 
    FLastProgressUpdateTime:=gettickcount; 
    result:=TRUE; 
  end else result:=FALSE; 
end; 
 
procedure TStatusDialog.ProgressUpdateTime; 
var 
  TimeMax, TimeLeft: longword; 
begin 
  TimeMax:=round(ProgressMax/ProgressPos * FProgressPosTime); 
  TimeLeft:=TimeMax-FProgressPosTime; 
 
  if TimeLeft > 60 then 
    label5.caption:=Format('Time left: %d minute(s)',[round(TimeLeft/60)]) 
  else 
    label5.caption:=Format('Time left: %d second(s)',[TimeLeft]) 
end; 
 
 
// updates non-empty strings only 
procedure TStatusDialog.UpdateStatus(title, text1, text2, text3, text4: shortstring); 
begin 
  if title <> '' then caption:=title; 
  if text1 <> '' then Label1.caption:=text1; 
  if text2 <> '' then Label2.caption:=text2; 
  if text3 <> '' then Label3.caption:=text3; 
  if text4 <> '' then Label4.caption:=text4; 
end; 
 
 
procedure TStatusDialog.CancelBtnClick(Sender: TObject); 
begin 
  UserCancel:=true; 
end; 
 
 
procedure TStatusDialog.FormShow(Sender: TObject); 
begin 
  UserCancel:=false; 
end; 
 
end.