Changeset 21 for trunk/Packages/Common/JobProgressView.pas

Timestamp:

Apr 3, 2025, 10:49:00 PM (2 weeks ago)

Author:

chronos

Message:

• Modified: Updated Common package.

File:

• trunk/Packages/Common/JobProgressView.pas (moved) (moved from trunk/Packages/Common/UJobProgressView.pas ) (31 diffs)

trunk/Packages/Common/JobProgressView.pas ¶

@@ -1 @@
-unit UJobProgressView;
-
-{$MODE Delphi}
+unit JobProgressView;
 
 interface
@@ -7 +5 @@
 uses
   SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
-  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math,
   DateUtils;
 
@@ -13 +11 @@
   EstimatedTimeShowTreshold = 4;
   EstimatedTimeShowTresholdTotal = 1;
-  MemoLogHeight = 200;
   UpdateInterval = 100; // ms
 
@@ -24 +21 @@
     FLock: TCriticalSection;
     FOnChange: TNotifyEvent;
+    FText: string;
     FValue: Integer;
     FMax: Integer;
     procedure SetMax(const AValue: Integer);
+    procedure SetText(AValue: string);
     procedure SetValue(const AValue: Integer);
   public
@@ -35 +34 @@
     property Value: Integer read FValue write SetValue;
     property Max: Integer read FMax write SetMax;
+    property Text: string read FText write SetText;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
@@ -69 +69 @@
   end;
 
+  TJobs = class(TObjectList<TJob>)
+  end;
+
   TJobThread = class(TListedThread)
     procedure Execute; override;
@@ -80 +83 @@
   TFormJobProgressView = class(TForm)
     ImageList1: TImageList;
+    LabelText: TLabel;
     Label2: TLabel;
     LabelOperation: TLabel;
@@ -86 +90 @@
     ListViewJobs: TListView;
     MemoLog: TMemo;
+    PanelText: TPanel;
     PanelProgressTotal: TPanel;
     PanelOperationsTitle: TPanel;
@@ -94 +99 @@
     ProgressBarTotal: TProgressBar;
     TimerUpdate: TTimer;
+    procedure FormHide(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure ReloadJobList;
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
-    procedure FormDestroy(Sender: TObject);
     procedure ListViewJobsData(Sender: TObject; Item: TListItem);
     procedure TimerUpdateTimer(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+    procedure UpdateHeight;
   public
     JobProgressView: TJobProgressView;
@@ -118 +126 @@
     TotalStartTime: TDateTime;
     Log: TStringList;
+    FForm: TFormJobProgressView;
     procedure SetTerminate(const AValue: Boolean);
     procedure UpdateProgress;
-    procedure ReloadJobList;
-    procedure StartJobs;
-    procedure UpdateHeight;
     procedure JobProgressChange(Sender: TObject);
   public
-    Form: TFormJobProgressView;
-    Jobs: TObjectList; // TListObject<TJob>
+    Jobs: TJobs;
     CurrentJob: TJob;
     CurrentJobIndex: Integer;
@@ -132 +137 @@
     destructor Destroy; override;
     procedure Clear;
-    procedure AddJob(Title: string; Method: TJobProgressViewMethod;
-      NoThreaded: Boolean = False; WaitFor: Boolean = False);
-    procedure Start(AAutoClose: Boolean = True);
+    function AddJob(Title: string; Method: TJobProgressViewMethod;
+      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
+    procedure Start;
     procedure Stop;
     procedure TermSleep(Delay: Integer);
+    property Form: TFormJobProgressView read FForm;
     property Terminate: Boolean read FTerminate write SetTerminate;
   published
@@ -148 +154 @@
   end;
 
-  //var
-  //  FormJobProgressView: TFormJobProgressView;
-
 procedure Register;
 
 resourcestring
   SExecuted = 'Executed';
+
 
 implementation
@@ -166 +170 @@
   STotalEstimatedTime = 'Total estimated time: %s';
   SFinished = 'Finished';
-  SOperations = 'Operations';
 
 procedure Register;
@@ -173 +176 @@
 end;
 
+{ TJobThread }
+
 procedure TJobThread.Execute;
 begin
   try
     try
-      //raise Exception.Create('Exception in job');
       ProgressView.CurrentJob.Method(Job);
     except
@@ -190 +194 @@
 end;
 
-procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
-  NoThreaded: Boolean = False; WaitFor: Boolean = False);
+{ TFormJobProgressView }
+
+procedure TFormJobProgressView.UpdateHeight;
 var
-  NewJob: TJob;
-begin
-  NewJob := TJob.Create;
-  NewJob.ProgressView := Self;
-  NewJob.Title := Title;
-  NewJob.Method := Method;
-  NewJob.NoThreaded := NoThreaded;
-  NewJob.WaitFor := WaitFor;
-  NewJob.Progress.Max := 100;
-  NewJob.Progress.Reset;
-  NewJob.Progress.OnChange := JobProgressChange;
-  Jobs.Add(NewJob);
+  H: Integer;
+  PanelOperationsVisible: Boolean;
+  PanelOperationsHeight: Integer;
+  PanelProgressVisible: Boolean;
+  PanelProgressTotalVisible: Boolean;
+  PanelLogVisible: Boolean;
+  MemoLogHeight: Integer = 200;
+  I: Integer;
+  ItemRect: TRect;
+  MaxH: Integer;
+begin
+    H := PanelOperationsTitle.Height;
+    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
+    if PanelOperationsVisible <> PanelOperations.Visible then
+      PanelOperations.Visible := PanelOperationsVisible;
+    if ListViewJobs.Items.Count > 0 then begin
+      Maxh := 0;
+      for I := 0 to ListViewJobs.Items.Count - 1 do
+      begin
+        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
+        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
+      end;
+      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
+    end else PanelOperationsHeight := Scale96ToScreen(8);
+    if PanelOperationsHeight <> PanelOperations.Height then
+      PanelOperations.Height := PanelOperationsHeight;
+    if PanelOperationsVisible then
+      H := H + PanelOperations.Height;
+
+    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
+    if PanelProgressVisible <> PanelProgress.Visible then
+      PanelProgress.Visible := PanelProgressVisible;
+    if PanelProgressVisible then
+      H := H + PanelProgress.Height;
+    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
+    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
+      PanelProgressTotal.Visible := PanelProgressTotalVisible;
+    if PanelProgressTotalVisible then
+      H := H + PanelProgressTotal.Height;
+    Constraints.MinHeight := H;
+    PanelLogVisible := MemoLog.Lines.Count > 0;
+    if PanelLogVisible <> PanelLog.Visible then
+      PanelLog.Visible := PanelLogVisible;
+    if PanelLogVisible then
+      H := H + Scale96ToScreen(MemoLogHeight);
+    if PanelText.Visible then
+      H := H + PanelText.Height;
+    if Height <> H then begin
+      Height := H;
+      Top := (Screen.Height - H) div 2;
+    end;
+end;
+
+procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
+var
+  ProgressBarPartVisible: Boolean;
+  ProgressBarTotalVisible: Boolean;
+begin
+  JobProgressView.UpdateProgress;
+  if Visible and (not ProgressBarPart.Visible) and
+  Assigned(JobProgressView.CurrentJob) and
+  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
+    ProgressBarPartVisible := True;
+    if ProgressBarPartVisible <> ProgressBarPart.Visible then
+      ProgressBarPart.Visible := ProgressBarPartVisible;
+    ProgressBarTotalVisible := True;
+    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
+      ProgressBarTotal.Visible := ProgressBarTotalVisible;
+  end;
+  if not Visible then begin
+    TimerUpdate.Interval := UpdateInterval;
+    if not JobProgressView.OwnerDraw then Show;
+  end;
+  if Assigned(JobProgressView.CurrentJob) then begin
+    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
+    if LabelText.Caption <> '' then begin
+      PanelText.Visible := True;
+      UpdateHeight;
+    end;
+  end;
+end;
+
+procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
+begin
+  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
+  with JobProgressView.Jobs[Item.Index] do begin
+    Item.Caption := Title;
+    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
+      else if Finished then Item.ImageIndex := 0
+      else Item.ImageIndex := 2;
+    Item.Data := JobProgressView.Jobs[Item.Index];
+  end;
+end;
+
+procedure TFormJobProgressView.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+end;
+
+procedure TFormJobProgressView.FormCreate(Sender: TObject);
+begin
+  Caption := SPleaseWait;
+  try
+    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
+    //  DirectorySeparator + 'horse.avi';
+    //Animate1.Active := True;
+  except
+
+  end;
+end;
+
+procedure TFormJobProgressView.ReloadJobList;
+begin
+  // Workaround for not showing first line
+  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
+  //Form.ListViewJobs.Refresh;
+
+  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
+    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
+  ListViewJobs.Refresh;
+  Application.ProcessMessages;
+  UpdateHeight;
+end;
+
+procedure TFormJobProgressView.FormShow(Sender: TObject);
+begin
+  ReloadJobList;
+end;
+
+procedure TFormJobProgressView.FormHide(Sender: TObject);
+begin
+  JobProgressView.Jobs.Clear;
+  ReloadJobList;
+end;
+
+procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+  CanClose := JobProgressView.Finished;
+  JobProgressView.Terminate := True;
+  Caption := SPleaseWait + STerminate;
+end;
+
+
+{ TJobProgressView }
+
+function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
+  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
+begin
+  Result := TJob.Create;
+  Result.ProgressView := Self;
+  Result.Title := Title;
+  Result.Method := Method;
+  Result.NoThreaded := NoThreaded;
+  Result.WaitFor := WaitFor;
+  Result.Progress.Max := 100;
+  Result.Progress.Reset;
+  Result.Progress.OnChange := JobProgressChange;
+  Jobs.Add(Result);
   //ReloadJobList;
 end;
 
-procedure TJobProgressView.Start(AAutoClose: Boolean = True);
-begin
-  AutoClose := AAutoClose;
-  StartJobs;
-end;
-
-procedure TJobProgressView.StartJobs;
+procedure TJobProgressView.Start;
 var
   I: Integer;
@@ -229 +374 @@
     Form.MemoLog.Clear;
 
+    Form.PanelText.Visible := False;
     Form.LabelEstimatedTimePart.Visible := False;
     Form.LabelEstimatedTimeTotal.Visible := False;
@@ -249 +395 @@
     I := 0;
     while I < Jobs.Count do
-    with TJob(Jobs[I]) do begin
+    with Jobs[I] do begin
       CurrentJobIndex := I;
-      CurrentJob := TJob(Jobs[I]);
+      CurrentJob := Jobs[I];
       JobProgressChange(Self);
       StartTime := Now;
@@ -258 +404 @@
       Form.ProgressBarPart.Visible := False;
       //Show;
-      ReloadJobList;
+      Form.ReloadJobList;
       Application.ProcessMessages;
       if NoThreaded then begin
@@ -264 +410 @@
         Method(CurrentJob);
       end else begin
+        Thread := TJobThread.Create(True);
         try
-          Thread := TJobThread.Create(True);
           with Thread do begin
             FreeOnTerminate := False;
@@ -296 +442 @@
     //if Visible then Hide;
     Form.MemoLog.Lines.Assign(Log);
-    if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
+    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
       Form.Hide;
     end;
-    Clear;
+    if not Form.Visible then Clear;
     Form.Caption := SFinished;
     //LabelEstimatedTimePart.Visible := False;
     Finished := True;
     CurrentJobIndex := -1;
-    ReloadJobList;
-  end;
-end;
-
-procedure TJobProgressView.UpdateHeight;
-var
-  H: Integer;
-  PanelOperationsVisible: Boolean;
-  PanelOperationsHeight: Integer;
-  PanelProgressVisible: Boolean;
-  PanelProgressTotalVisible: Boolean;
-  PanelLogVisible: Boolean;
-begin
-  with Form do begin
-  H := PanelOperationsTitle.Height;
-  PanelOperationsVisible := Jobs.Count > 0;
-  if PanelOperationsVisible <> PanelOperations.Visible then
-    PanelOperations.Visible := PanelOperationsVisible;
-  PanelOperationsHeight := 8 + 18 * Jobs.Count;
-  if PanelOperationsHeight <> PanelOperations.Height then
-    PanelOperations.Height := PanelOperationsHeight;
-  if PanelOperationsVisible then
-    H := H + PanelOperations.Height;
-
-  PanelProgressVisible := (Jobs.Count > 0) and not Finished;
-  if PanelProgressVisible <> PanelProgress.Visible then
-    PanelProgress.Visible := PanelProgressVisible;
-  if PanelProgressVisible then
-    H := H + PanelProgress.Height;
-  PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
-  if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
-    PanelProgressTotal.Visible := PanelProgressTotalVisible;
-  if PanelProgressTotalVisible then
-    H := H + PanelProgressTotal.Height;
-  Constraints.MinHeight := H;
-  PanelLogVisible := MemoLog.Lines.Count > 0;
-  if PanelLogVisible <> PanelLog.Visible then
-    PanelLog.Visible := PanelLogVisible;
-  if PanelLogVisible then
-    H := H + MemoLogHeight;
-  if Height <> H then Height := H;
+    Form.ReloadJobList;
   end;
 end;
@@ -352 +458 @@
   if Assigned(FOnOwnerDraw) then
     FOnOwnerDraw(Self);
-end;
-
-procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
-var
-  ProgressBarPartVisible: Boolean;
-  ProgressBarTotalVisible: Boolean;
-begin
-  JobProgressView.UpdateProgress;
-  if Visible and (not ProgressBarPart.Visible) and
-  Assigned(JobProgressView.CurrentJob) and
-  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
-    ProgressBarPartVisible := True;
-    if ProgressBarPartVisible <> ProgressBarPart.Visible then
-      ProgressBarPart.Visible := ProgressBarPartVisible;
-    ProgressBarTotalVisible := True;
-    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
-      ProgressBarTotal.Visible := ProgressBarTotalVisible;
-  end;
-  if not Visible then begin
-    TimerUpdate.Interval := UpdateInterval;
-    if not JobProgressView.OwnerDraw then Show;
-  end;
-end;
-
-procedure TFormJobProgressView.FormDestroy(Sender:TObject);
-begin
-end;
-
-procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
-begin
-  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
-  with TJob(JobProgressView.Jobs[Item.Index]) do begin
-    Item.Caption := Title;
-    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
-      else if Finished then Item.ImageIndex := 0
-      else Item.ImageIndex := 2;
-    Item.Data := JobProgressView.Jobs[Item.Index];
-  end;
-end;
-
-procedure TFormJobProgressView.FormClose(Sender: TObject;
-  var CloseAction: TCloseAction);
-begin
-  ListViewJobs.Clear;
-end;
-
-procedure TFormJobProgressView.FormCreate(Sender: TObject);
-begin
-  Caption := SPleaseWait;
-  try
-    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
-    //  DirectorySeparator + 'horse.avi';
-    //Animate1.Active := True;
-  except
-
-  end;
 end;
 
@@ -428 +478 @@
 end;
 
-procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
-begin
-  CanClose := JobProgressView.Finished;
-  JobProgressView.Terminate := True;
-  Caption := SPleaseWait + STerminate;
-end;
-
 procedure TJobProgressView.SetTerminate(const AValue: Boolean);
 var
@@ -441 +484 @@
   if AValue = FTerminate then Exit;
   for I := 0 to Jobs.Count - 1 do
-    TJob(Jobs[I]).Terminate := AValue;
+    Jobs[I].Terminate := AValue;
   FTerminate := AValue;
 end;
@@ -490 +533 @@
 end;
 
-procedure TJobProgressView.ReloadJobList;
-begin
-  UpdateHeight;
-  // Workaround for not showing first line
-  Form.ListViewJobs.Items.Count := Jobs.Count + 1;
-  Form.ListViewJobs.Refresh;
-
-  if Form.ListViewJobs.Items.Count <> Jobs.Count then
-    Form.ListViewJobs.Items.Count := Jobs.Count;
-  Form.ListViewJobs.Refresh;
-  //Application.ProcessMessages;
-end;
-
 constructor TJobProgressView.Create(TheOwner: TComponent);
 begin
   inherited;
   if not (csDesigning in ComponentState) then begin
-    Form := TFormJobProgressView.Create(Self);
-    Form.JobProgressView := Self;
-  end;
-  Jobs := TObjectList.Create;
+    FForm := TFormJobProgressView.Create(Self);
+    FForm.JobProgressView := Self;
+  end;
+  Jobs := TJobs.Create;
   Log := TStringList.Create;
   //PanelOperationsTitle.Height := 80;
-  ShowDelay := 0; //1000; // ms
+  AutoClose := True;
+  ShowDelay := 0;
 end;
 
@@ -519 +550 @@
 begin
   Jobs.Clear;
+  Log.Clear;
   //ReloadJobList;
 end;
@@ -528 +560 @@
   inherited;
 end;
+
+{ TProgress }
 
 procedure TProgress.SetMax(const AValue: Integer);
@@ -536 +570 @@
     if FMax < 1 then FMax := 1;
     if FValue >= FMax then FValue := FMax;
+  finally
+    FLock.Release;
+  end;
+end;
+
+procedure TProgress.SetText(AValue: string);
+begin
+  try
+    FLock.Acquire;
+    if FText = AValue then Exit;
+    FText := AValue;
   finally
     FLock.Release;
@@ -563 +608 @@
 end;
 
-{ TProgress }
-
 procedure TProgress.Increment;
 begin
-  try
-    FLock.Acquire;
+  FLock.Acquire;
+  try
     Value := Value + 1;
   finally
@@ -577 +620 @@
 procedure TProgress.Reset;
 begin
-  try
-    FLock.Acquire;
+  FLock.Acquire;
+  try
     FValue := 0;
   finally
@@ -594 +637 @@
 begin
   FLock.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -625 +668 @@
 destructor TJob.Destroy;
 begin
-  Progress.Free;
+  FreeAndNil(Progress);
   inherited;
 end;