Changeset 22 for JobProgressView/UJobProgressView.pas

Timestamp:

May 14, 2010, 7:03:09 AM (15 years ago)

Author:

george

Message:

• Upraveno: Změna podpory pro Lazarus.
• Upraveno: Přepracovány struktury tříd do čistější podoby.

File:

• JobProgressView/UJobProgressView.pas (modified) (7 diffs)

JobProgressView/UJobProgressView.pas

@@ -1 +1 @@
 unit UJobProgressView;
 
+{$MODE Delphi}
+
 interface
 
 uses
-  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, ImgList, ComCtrls, StdCtrls, ExtCtrls;
+  SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls;
+
+const
+  EstimatedTimeShowTreshold = 4;
 
 type
-  TMethod = procedure(Thread: TThread) of object;
+
+  { TProgress }
+
+  TProgress = class
+  private
+    FOnChange: TNotifyEvent;
+    FValue: Integer;
+    FMax: Integer;
+    procedure SetMax(const AValue: Integer);
+    procedure SetValue(const AValue: Integer);
+  public
+    procedure Increment;
+    procedure Reset;
+    constructor Create;
+    property Value: Integer read FValue write SetValue;
+    property Max: Integer read FMax write SetMax;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  end;
+
+  TJobProgressView = class;
+  TJobThread = class;
+  TJob = class;
+
+  TJobProgressViewMethod = procedure(Job: TJob) of object;
+
+  { TJob }
+
+  TJob = class
+    StartTime: TDateTime;
+    EndTime: TDateTime;
+    ProgressView: TJobProgressView;
+    Title: string;
+    Method: TJobProgressViewMethod;
+    Direct: Boolean;
+    WaitFor: Boolean;
+    Terminate: Boolean;
+    Progress: TProgress;
+    Thread: TJobThread;
+    constructor Create;
+    destructor Destroy; override;
+  end;
 
   TJobThread = class(TThread)
     procedure Execute; override;
+  private
+    ExceptionText: string;
   public
-    ExceptionText: string;
-    Index: Integer;
-    Title: string;
-    Method: TMethod;
-  end;
+    ProgressView: TJobProgressView;
+    Job: TJob;
+  end;
+
+  { TJobProgressView }
 
   TJobProgressView = class(TForm)
@@ -26 +73 @@
     Label2: TLabel;
     Timer1: TTimer;
-    Label3: TLabel;
-    Animate1: TAnimate;
+    LabelEstimatedTime: TLabel;
     procedure Timer1Timer(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
-    //FLastProgress: Real;
-    FProgress: Real;
-    FPosition: Integer;
-    Jobs: array of record
-      Method: TMethod;
-      Direct: Boolean;
-    end;
-    Job: TJobThread;
-    WindowList: Pointer;
-    StartTime: TDateTime;
-    procedure SetProgress(Value: Real);
+    FTerminate: Boolean;
+    procedure SetTerminate(const AValue: Boolean);
+    //WindowList: Pointer;
     procedure UpdateProgress;
+    procedure ReloadJobList;
   public
-    Terminate: Boolean;
-    procedure AddJob(Title: string; Method: TMethod; Direct: Boolean = False);
+    Jobs: TList; // of TJob
+    CurrentJob: TJob;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure AddJob(Title: string; Method: TJobProgressViewMethod;
+      Direct: Boolean = False; WaitFor: Boolean = False);
     procedure Start;
     procedure Stop;
     procedure TermSleep(Delay: Integer);
-    property Progress: Real read FProgress write SetProgress;
-  end;
-
-var
-  JobProgressView: TJobProgressView;
+    property Terminate: Boolean read FTerminate write SetTerminate;
+  end;
 
 implementation
 
-{$R *.dfm}
+{$R *.lfm}
 
 procedure TJobThread.Execute;
@@ -65 +106 @@
   try
     //raise Exception.Create('dsds');
-    Method(Self);
+    Job.Method(Self.Job);
     Terminate;
   except
     on E:Exception do begin
-      ExceptionText := 'V úloze "' + Title + '" došlo k vyjímce: ' + E.Message;
+      ExceptionText := 'V úloze "' + Job.Title + '" došlo k vyjímce: ' + E.Message;
       Terminate;
     end;
@@ -75 +116 @@
 end;
 
-procedure TJobProgressView.AddJob(Title: string; Method: TMethod; Direct: Boolean = False);
-var
-  NewItem: TListItem;
-begin
-  with ListView1, Items do begin
-    BeginUpdate;
-    NewItem := Add;
-    with NewItem do begin
-      Caption := Title;
-      ImageIndex := 2;
+procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
+  Direct: Boolean = False; WaitFor: Boolean = False);
+var
+  NewJob: TJob;
+begin
+  NewJob := TJob.Create;
+  NewJob.ProgressView := Self;
+  NewJob.Title := Title;
+  NewJob.Method := Method;
+  NewJob.Direct := Direct;
+  NewJob.WaitFor := WaitFor;
+  NewJob.Progress.Max := 100;
+  NewJob.Progress.Reset;
+  Jobs.Add(NewJob);
+  ReloadJobList;
+end;
+
+procedure TJobProgressView.Start;
+var
+  LocalExceptionText: string;
+  JobThread: TJobThread;
+  I: Integer;
+begin
+  Caption := 'Prosím čekejte...';
+  try
+    //WindowList := DisableTaskWindows(0);
+    Height := 100 + 18 * Jobs.Count;
+    //Show;
+    Timer1.Enabled := True;
+    // Timer1Timer(Self);
+    for I := 0 to Jobs.Count - 1 do
+    with TJob(Jobs[I]) do begin
+      CurrentJob := Jobs[I];
+      StartTime := Now;
+      ListView1.Items.Item[I].ImageIndex := 1;
+      LabelEstimatedTime.Caption := '';
+      ProgressBar1.Position := 0;
+      Application.ProcessMessages;
+      if Direct then Method(CurrentJob) else begin
+        JobThread := TJobThread.Create(True);
+        with JobThread do begin
+          Job := CurrentJob;
+          ProgressView := Self;
+          Resume;
+          while not Terminated do begin
+            Application.ProcessMessages;
+            Sleep(1);
+          end;
+          WaitFor;
+          LocalExceptionText := ExceptionText;
+          Free;
+        end;
+        if LocalExceptionText <> '' then
+          raise Exception.Create(LocalExceptionText);
+      end;
+      ProgressBar1.Hide;
+      ListView1.Items.Item[I].ImageIndex := 0;
+      if Terminate then Break;
+      EndTime := Now;
     end;
-    SetLength(Jobs, Length(Jobs) + 1);
-    Jobs[High(Jobs)].Method := Method;
-    Jobs[High(Jobs)].Direct := Direct;
-    EndUpdate;
-  end;
-end;
-
-procedure TJobProgressView.Start;
-var
-  I: Integer;
-  LocalExceptionText: string;
-begin
-  Caption := 'Prosím èekejte...';
-  try
-  Terminate := False;
-  WindowList := DisableTaskWindows(0);
-  Height := 100 + 18 * ListView1.Items.Count;
-  //Show;
-  Timer1.Enabled := True;
-//  Timer1Timer(Self);
-  for I := 0 to High(Jobs) do begin
-    StartTime := Now;
-    ListView1.Items.Item[I].ImageIndex := 1;
-    Label3.Caption := '';
-    ProgressBar1.Position := 0;
-    FPosition := 0;
-    FProgress := 0;
-    Application.ProcessMessages;
-    if Jobs[I].Direct then Jobs[I].Method(nil) else begin
-      Job := TJobThread.Create(True);
-      with Job do begin
-        Method := Jobs[I].Method;
-        Title := ListView1.Items.Item[I].Caption;
-        Index := I;
-        Resume;
-        while not Terminated do begin
-          Application.ProcessMessages;
-          Sleep(1);
-        end;
-        WaitFor;
-        LocalExceptionText := ExceptionText;
-        Free;
-      end;
-      if LocalExceptionText <> '' then raise Exception.Create(LocalExceptionText);
-    end;
-    ProgressBar1.Hide;
-    ListView1.Items.Item[I].ImageIndex := 0;
-    if Terminate then Break;
-  end;
+    CurrentJob := nil;
   finally
     Timer1.Enabled := False;
-    EnableTaskWindows(WindowList);
-    if Visible then begin
-      JobProgressView.Hide;
-    end;
-    SetLength(Jobs, 0);
-    with ListView1.Items do begin
-      BeginUpdate;
-      Clear;
-      EndUpdate;
-    end;
+    //EnableTaskWindows(WindowList);
+    if Visible then Hide;
   end;
 end;
@@ -153 +187 @@
 begin
   UpdateProgress;
-  if (not ProgressBar1.Visible) and (FProgress > 0) then ProgressBar1.Visible := True;
+  if (not ProgressBar1.Visible) and Assigned(CurrentJob) and
+  (CurrentJob.Progress.Value > 0) then
+    ProgressBar1.Visible := True;
   if not Visible then Show;
 end;
@@ -160 +196 @@
 begin
   try
-    Animate1.FileName := ExtractFileDir(Application.ExeName) + '\horse.avi';
-    Animate1.Active := True;
+    //Animate1.FileName := ExtractFileDir(Application.ExeName) + '\horse.avi';
+    //Animate1.Active := True;
   except
 
@@ -189 +225 @@
   CanClose := Terminate;
   Terminate := True;
-  Caption := 'Prosím èekejte...pøerušení';
-end;
-
-procedure TJobProgressView.SetProgress(Value: Real);
-begin
-  if (Value * 100) > FPosition then begin
-    FPosition := Trunc(Value * 100) + 1;
-    UpdateProgress;
-  end;
-  FProgress := Value;
+  Caption := 'Prosím čekejte...přerušení';
+end;
+
+procedure TJobProgressView.SetTerminate(const AValue: Boolean);
+var
+  I: Integer;
+begin
+  for I := 0 to Jobs.Count - 1 do
+    TJob(Jobs[I]).Terminate := AValue;
+  FTerminate := AValue;
 end;
 
 procedure TJobProgressView.UpdateProgress;
 begin
-  ProgressBar1.Position := FPosition;
-  if (FPosition > 4) and (FProgress > 0) then
-    Label3.Caption := TimeToStr((Now - StartTime) / FProgress * (1 - FProgress));
+  if Assigned(CurrentJob) then
+  with CurrentJob do begin
+    ProgressBar1.Max := Progress.Max;
+    ProgressBar1.Position := Progress.Value;
+    if (Progress.Value >= EstimatedTimeShowTreshold) then
+      LabelEstimatedTime.Caption :=
+        TimeToStr((Now - StartTime) / Progress.Value * (Progress.Max - Progress.Value));
+  end;
+end;
+
+procedure TJobProgressView.ReloadJobList;
+var
+  NewItem: TListItem;
+  I: Integer;
+begin
+  with ListView1, Items do begin
+    BeginUpdate;
+    Clear;
+    for I := 0 to Jobs.Count - 1 do
+    with TJob(Jobs[I]) do begin
+      NewItem := Add;
+      with NewItem do begin
+        Caption := Title;
+        ImageIndex := 2;
+        Data := Jobs[I];
+      end;
+    end;
+    EndUpdate;
+  end;
+end;
+
+constructor TJobProgressView.Create(TheOwner: TComponent);
+begin
+  inherited;
+  Jobs := TList.Create;
+end;
+
+procedure TJobProgressView.Clear;
+var
+  I: Integer;
+begin
+  for I := 0 to Jobs.Count - 1 do
+    TJob(Jobs[I]).Destroy;
+  Jobs.Clear;
+  ReloadJobList;
+end;
+
+destructor TJobProgressView.Destroy;
+begin
+  Clear;
+  Jobs.Destroy;
+  inherited Destroy;
+end;
+
+procedure TProgress.SetMax(const AValue: Integer);
+begin
+  FMax := AValue;
+  if FValue >= FMax then FValue := FMax;
+end;
+
+procedure TProgress.SetValue(const AValue: Integer);
+var
+  Change: Boolean;
+begin
+  if AValue < Max then begin
+    change := AValue <> FValue;
+    FValue := AValue;
+    if Change and Assigned(FOnChange) then FOnChange(Self);
+  end;
+end;
+
+{ TProgress }
+
+procedure TProgress.Increment;
+begin
+  Value := Value + 1;
+end;
+
+procedure TProgress.Reset;
+begin
+  FValue := 0;
+end;
+
+constructor TProgress.Create;
+begin
+  FMax := 100;
+end;
+
+{ TJob }
+
+constructor TJob.Create;
+begin
+  Progress := TProgress.Create;
+  Terminate := False;
+end;
+
+destructor TJob.Destroy;
+begin
+  Progress.Destroy;
+  inherited Destroy;
 end;