📄 itigprogressknown.pas
字号:
unit ItigProgressKnown;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ExtCtrls, Progress, syncobjs, ItigNet;
type
TItigProgressKnown = class(TForm, IUnknown, IProgress)
Panel1: TPanel;
Image1: TImage;
lblMessage: TLabel;
lblTime: TLabel;
tmrTiming: TTimer;
cmdAct: TButton;
prProgress: TProgressBar;
lblPercent: TLabel;
procedure tmrTimingTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure cmdActClick(Sender: TObject);
private
totalActions: Integer;
doneActions: Integer;
showTime: Boolean;
start: TDateTime;
ivInfo: TItigNet;
ivAutoClose: Boolean;
ivTimeReached: Boolean;
ivDoClose: Boolean;
ivCanClose: Boolean;
ivPhases: Integer;
ivCurrentPhase: Integer;
ivIsPhased: Boolean;
ivAction : String;
ivCancelled: Boolean;
ThreadWorking : Boolean;
public
ActionDescription : String;
property AutoClose : Boolean read ivAutoClose write ivAutoClose;
procedure setNoActions(toVal: Integer);
procedure actionDone();
procedure SetPos(n : Integer);
procedure setMessage(msg: String);
procedure showProgress(b: Boolean);
procedure OnThreadComplete(var Message: TMessage); message WM_THREAD_COMPLETE;
procedure Execute(Action: String; toInfo: TItigNet);
procedure SetInfo(toInfo: TItigNet);
property Info: TItigNet Write setInfo;
property ShowET: Boolean read showTime write showTime;
function GetHandle : hWnd;
function IsCancelled: Boolean;
procedure Done;
procedure PhaseDone;
procedure SetPhases(noPhases: integer);
end;
var
ProgressKnown: TItigProgressKnown;
implementation
uses AutoUpdate;
{$R *.DFM}
procedure TItigProgressKnown.actionDone();
begin
doneActions := doneActions + 1;
if TotalActions > 0 then
begin
lblPercent.Caption := format('%2.0f%%', [(doneActions / totalActions )*100]);
end;
prProgress.Position := doneActions;
end;
procedure TItigProgressKnown.SetPos(n : Integer);
begin
doneActions := n;
if TotalActions > 0 then
begin
lblPercent.Caption := format('%2.0f%%', [(doneActions / totalActions )*100]);
end;
prProgress.Position := n;
end;
procedure TItigProgressKnown.setNoActions(toVal: Integer);
begin
totalActions := toVal;
doneActions := 0;
start := Now;
prProgress.Max := totalActions;
prProgress.Step := 1;
prProgress.Position := 0;
lblTime.Caption := 'Estimated time remaining...';
end;
procedure TItigProgressKnown.tmrTimingTimer(Sender: TObject);
var
actRem: Integer;
currTime, remTime: Double;
timePerAction: Double;
h, m, s: Integer;
begin
if not ivTimeReached then
begin
ivTimeReached := true;
if ivDoClose then
begin
ModalResult := mrOk;
Exit;
end;
end;
if Not((totalActions <= 0) or (doneActions = 0) or (totalActions = doneActions)) then
begin
currTime := (Now - start) * 86400; //24 * 60 * 60
lblTime.Caption := 'Estimated time remaining...';
timePerAction := currTime / doneActions;
actRem := totalActions - doneActions;
remTime := timePerAction * actRem;
if (actRem / totalActions) < 0.98 then
begin
h := Trunc(remTime / 1440); //24 * 60
remTime := remTime - (h * 1440);
m := Trunc(remTime / 60);
remTime := remTime - (m * 60);
s := Trunc(remTime);
lblTime.Caption := 'Estimated time remaining ' + format('%.2d', [h]) + ':' + format('%.2d', [m]) + ':' + format('%.2d', [s]);
end;
tmrTiming.Interval := Trunc((currTime * 1000) / 20);
if tmrTiming.Interval < 1000 then tmrTiming.Interval := 1000;
end;
end;
procedure TItigProgressKnown.setMessage(msg: String);
begin
if ivIsPhased then
begin
lblMessage.Caption := format('Stage %d of %d: %s', [ivCurrentPhase, ivPhases, msg]);
end
else
begin
lblMessage.Caption := msg;
end;
end;
procedure TItigProgressKnown.OnThreadComplete(var Message: TMessage);
begin
ivInfo.GotMessage;
ThreadWorking := False;
ivCanClose := true;
cmdAct.enabled := true;
if ivInfo.GetResult = irTryAgain then
begin
if ivInfo.GetErrorMsg = '' then
begin
// retry somehow...
ivInfo.ResultCode := irReady;
ivDoClose := false;
ivTimeReached := false;
ThreadWorking := True;
ivCanClose := False;
ivCancelled := False;
totalActions := 0;
doneActions := 0;
ivInfo.BeginExecute(ivAction, self);
exit;
end
else
begin
// for now assume that we need to install the cert.
if MessageDlg('Before you can use the Info-In.com client software you must install the server certificate. This is used to guarantee the security of your connection to the Info-In.com server. Do you wish to install the certificate?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
// retry somehow...
MessageDlg('Once the certificate is installed, click OK to continue', mtInformation, [mbOK], 0);
ivInfo.ResultCode := irReady;
ivDoClose := false;
ivTimeReached := false;
ThreadWorking := True;
ivCanClose := False;
ivCancelled := False;
totalActions := 0;
doneActions := 0;
ivInfo.BeginExecute(ivAction, self);
exit;
end
else
begin
if MessageDlg('It is possible to run the Info-In.com client in low security mode. This means that it is harder to guarantee that the Info-In.com server is who it says it is. Do you wish to run in low security mode?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
ivInfo.Option.LowSecurity := True;
//ivInfo.Option.SaveInternet;
// retry somehow...
ivInfo.ResultCode := irReady;
ivDoClose := false;
ivTimeReached := false;
ThreadWorking := True;
ivCanClose := False;
ivCancelled := False;
totalActions := 0;
doneActions := 0;
ivInfo.BeginExecute(ivAction, self);
exit;
end
else
begin
ivInfo.ResultCode := irError;
end;
end;
end;
end;
if (ivInfo.GetResult = irError) then
begin
ivInfo.Debug('Error Message: ' + ivInfo.GetErrorMsg);
ivInfo.ThreadComplete(Message);
MessageDlg(ivInfo.GetErrorMsg, mtError, [mbOk], 0);
ModalResult := mrCancel;
end
else if (ivInfo.GetResult = irCancel) then
begin
MessageDlg('Operation cancelled at user request', mtInformation, [mbOK], 0);
ivInfo.Debug('Process Cancelled');
ivInfo.ThreadComplete(Message);
ModalResult := mrCancel;
end
else
begin
//ivInfo.Debug('Done Message');
ivInfo.ThreadComplete(Message);
SetPos(totalActions);
if AutoClose then
begin
cmdAct.enabled := false;
if ivTimeReached then
begin
ModalResult := mrOK;
end
else
begin
ivDoClose := true;
end;
end;
end;
end;
procedure TItigProgressKnown.Execute(Action: String; toInfo: TItigNet);
begin
try
ivDoClose := false;
ivTimeReached := false;
ivAction := Action;
SetInfo(toInfo);
ThreadWorking := True;
ivCanClose := False;
ivCancelled := False;
toInfo.Debug('BeginExecute' );
ivInfo.BeginExecute(Action, self);
toInfo.Debug('Show Modal' );
ShowModal;
toInfo.Debug('Show Modal Done');
except
on E : Exception do
begin
toInfo.Debug('There was an exception ' + E.Message);
end;
end;
end;
procedure TItigProgressKnown.SetInfo(toInfo: TItigNet);
begin
ivInfo := toInfo;
end;
procedure TItigProgressKnown.showProgress(b:Boolean);
begin
prProgress.visible := b;
lblTime.visible := b;
lblPercent.visible := b;
end;
function TItigProgressKnown.GetHandle : hWnd;
begin
Result := Handle;
end;
procedure TItigProgressKnown.Done;
begin
cmdAct.Caption := '&Ok';
cmdAct.ModalResult := mrOk;
lblTime.Caption := ActionDescription + 'Complete';
lblPercent.Caption := '100%';
if not AutoClose then
begin
Beep;
end;
if totalActions = 0 then
begin
setNoActions(1);
end;
SetPos(totalActions);
end;
procedure TItigProgressKnown.PhaseDone;
begin
ivCurrentPhase := ivCurrentPhase + 1;
setNoActions(100);
end;
procedure TItigProgressKnown.SetPhases(noPhases: integer);
begin
ivIsPhased := true;
ivPhases := noPhases;
ivCurrentPhase := 1;
end;
procedure TItigProgressKnown.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := ivCanClose;
end;
procedure TItigProgressKnown.FormCreate(Sender: TObject);
var
ResName : String;
hInst : HMODULE;
begin
try
with Owner as TAutoUpdate do
begin
ResName := ResourceName;
if Length(ResName) > 0 then
begin
// get the instance of the app we are upgrading....
if Length(ResourceImage) > 0 then
begin
hInst := LoadLibraryEx(PChar(ResourceImage), 0, LOAD_LIBRARY_AS_DATAFILE);
try
Image1.Picture.Bitmap.LoadFromResourceName(hInst, ResName);
finally
FreeLibrary(hInst);
end;
end
else
begin
Image1.Picture.Bitmap.LoadFromResourceName(hInstance, ResName);
end;
end;
end;
except
end;
ivIsPhased := false;
ivCanClose := True;
ivAutoClose := true;
ThreadWorking := False;
ivPhases := 0;
end;
procedure TItigProgressKnown.cmdActClick(Sender: TObject);
begin
cmdAct.Enabled := false;
ivCancelled := true;
ivInfo.Debug('Cancel' );
end;
function TItigProgressKnown.IsCancelled: Boolean;
begin
Result := ivCancelled;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -