statusdlg.pas

国外著名恢复软件Drive_Rescue 公布的早期源码 版本是1.8 delphi6环境开发的。

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.