Ignore:
Timestamp:
May 1, 2018, 10:18:03 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Updated newer Common package files.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/Packages/Common/UJobProgressView.pas

    r116 r192  
    66
    77uses
    8   SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     8  LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
    1010  DateUtils;
    1111
     
    1313  EstimatedTimeShowTreshold = 4;
    1414  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1615  UpdateInterval = 100; // ms
    1716
     
    2423    FLock: TCriticalSection;
    2524    FOnChange: TNotifyEvent;
     25    FText: string;
    2626    FValue: Integer;
    2727    FMax: Integer;
    2828    procedure SetMax(const AValue: Integer);
     29    procedure SetText(AValue: string);
    2930    procedure SetValue(const AValue: Integer);
    3031  public
     
    3536    property Value: Integer read FValue write SetValue;
    3637    property Max: Integer read FMax write SetMax;
     38    property Text: string read FText write SetText;
    3739    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3840  end;
     
    6971  end;
    7072
     73  TJobs = class(TObjectList)
     74  end;
     75
    7176  TJobThread = class(TListedThread)
    7277    procedure Execute; override;
     
    8085  TFormJobProgressView = class(TForm)
    8186    ImageList1: TImageList;
     87    LabelText: TLabel;
    8288    Label2: TLabel;
    8389    LabelOperation: TLabel;
     
    8692    ListViewJobs: TListView;
    8793    MemoLog: TMemo;
     94    PanelText: TPanel;
    8895    PanelProgressTotal: TPanel;
    8996    PanelOperationsTitle: TPanel;
     
    94101    ProgressBarTotal: TProgressBar;
    95102    TimerUpdate: TTimer;
     103    procedure FormHide(Sender: TObject);
     104    procedure FormShow(Sender: TObject);
     105    procedure ReloadJobList;
    96106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97107    procedure FormDestroy(Sender: TObject);
     
    100110    procedure FormCreate(Sender: TObject);
    101111    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     112    procedure UpdateHeight;
    102113  public
    103114    JobProgressView: TJobProgressView;
     
    118129    TotalStartTime: TDateTime;
    119130    Log: TStringList;
     131    FForm: TFormJobProgressView;
    120132    procedure SetTerminate(const AValue: Boolean);
    121133    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125134    procedure JobProgressChange(Sender: TObject);
    126135  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     136    Jobs: TJobs;
    129137    CurrentJob: TJob;
    130138    CurrentJobIndex: Integer;
     
    132140    destructor Destroy; override;
    133141    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     142    function AddJob(Title: string; Method: TJobProgressViewMethod;
     143      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     144    procedure Start;
    137145    procedure Stop;
    138146    procedure TermSleep(Delay: Integer);
     147    property Form: TFormJobProgressView read FForm;
    139148    property Terminate: Boolean read FTerminate write SetTerminate;
    140149  published
     
    166175  STotalEstimatedTime = 'Total estimated time: %s';
    167176  SFinished = 'Finished';
    168   SOperations = 'Operations';
     177  SOperations = 'Operations:';
    169178
    170179procedure Register;
     
    172181  RegisterComponents('Common', [TJobProgressView]);
    173182end;
     183
     184{ TJobThread }
    174185
    175186procedure TJobThread.Execute;
     
    190201end;
    191202
    192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    193   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203function Scale96ToScreen(const ASize: Integer): Integer;
     204begin
     205  Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
     206end;
     207
     208{ TFormJobProgressView }
     209
     210procedure TFormJobProgressView.UpdateHeight;
    194211var
    195   NewJob: TJob;
    196 begin
    197   NewJob := TJob.Create;
    198   NewJob.ProgressView := Self;
    199   NewJob.Title := Title;
    200   NewJob.Method := Method;
    201   NewJob.NoThreaded := NoThreaded;
    202   NewJob.WaitFor := WaitFor;
    203   NewJob.Progress.Max := 100;
    204   NewJob.Progress.Reset;
    205   NewJob.Progress.OnChange := JobProgressChange;
    206   Jobs.Add(NewJob);
     212  H: Integer;
     213  PanelOperationsVisible: Boolean;
     214  PanelOperationsHeight: Integer;
     215  PanelProgressVisible: Boolean;
     216  PanelProgressTotalVisible: Boolean;
     217  PanelLogVisible: Boolean;
     218  MemoLogHeight: Integer = 200;
     219  I: Integer;
     220  ItemRect: TRect;
     221  MaxH: Integer;
     222begin
     223    H := PanelOperationsTitle.Height;
     224    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     225    if PanelOperationsVisible <> PanelOperations.Visible then
     226      PanelOperations.Visible := PanelOperationsVisible;
     227    if ListViewJobs.Items.Count > 0 then begin
     228      Maxh := 0;
     229      for I := 0 to ListViewJobs.Items.Count - 1 do
     230      begin
     231        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     232        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     233      end;
     234      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     235    end else PanelOperationsHeight := Scale96ToScreen(8);
     236    if PanelOperationsHeight <> PanelOperations.Height then
     237      PanelOperations.Height := PanelOperationsHeight;
     238    if PanelOperationsVisible then
     239      H := H + PanelOperations.Height;
     240
     241    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     242    if PanelProgressVisible <> PanelProgress.Visible then
     243      PanelProgress.Visible := PanelProgressVisible;
     244    if PanelProgressVisible then
     245      H := H + PanelProgress.Height;
     246    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     247    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     248      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     249    if PanelProgressTotalVisible then
     250      H := H + PanelProgressTotal.Height;
     251    Constraints.MinHeight := H;
     252    PanelLogVisible := MemoLog.Lines.Count > 0;
     253    if PanelLogVisible <> PanelLog.Visible then
     254      PanelLog.Visible := PanelLogVisible;
     255    if PanelLogVisible then
     256      H := H + Scale96ToScreen(MemoLogHeight);
     257    if PanelText.Visible then
     258      H := H + PanelText.Height;
     259    if Height <> H then begin
     260      Height := H;
     261      Top := (Screen.Height - H) div 2;
     262    end;
     263end;
     264
     265procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     266var
     267  ProgressBarPartVisible: Boolean;
     268  ProgressBarTotalVisible: Boolean;
     269begin
     270  JobProgressView.UpdateProgress;
     271  if Visible and (not ProgressBarPart.Visible) and
     272  Assigned(JobProgressView.CurrentJob) and
     273  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     274    ProgressBarPartVisible := True;
     275    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     276      ProgressBarPart.Visible := ProgressBarPartVisible;
     277    ProgressBarTotalVisible := True;
     278    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     279      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     280  end;
     281  if not Visible then begin
     282    TimerUpdate.Interval := UpdateInterval;
     283    if not JobProgressView.OwnerDraw then Show;
     284  end;
     285  if Assigned(JobProgressView.CurrentJob) then begin
     286    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     287    if LabelText.Caption <> '' then begin
     288      PanelText.Visible := True;
     289      UpdateHeight;
     290    end;
     291  end;
     292end;
     293
     294procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     295begin
     296end;
     297
     298procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     299begin
     300  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     301  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     302    Item.Caption := Title;
     303    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     304      else if Finished then Item.ImageIndex := 0
     305      else Item.ImageIndex := 2;
     306    Item.Data := JobProgressView.Jobs[Item.Index];
     307  end;
     308end;
     309
     310procedure TFormJobProgressView.FormClose(Sender: TObject;
     311  var CloseAction: TCloseAction);
     312begin
     313end;
     314
     315procedure TFormJobProgressView.FormCreate(Sender: TObject);
     316begin
     317  Caption := SPleaseWait;
     318  try
     319    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     320    //  DirectorySeparator + 'horse.avi';
     321    //Animate1.Active := True;
     322  except
     323
     324  end;
     325end;
     326
     327procedure TFormJobProgressView.ReloadJobList;
     328begin
     329  // Workaround for not showing first line
     330  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     331  //Form.ListViewJobs.Refresh;
     332
     333  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     334    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     335  ListViewJobs.Refresh;
     336  Application.ProcessMessages;
     337  UpdateHeight;
     338end;
     339
     340procedure TFormJobProgressView.FormShow(Sender: TObject);
     341begin
     342  ReloadJobList;
     343end;
     344
     345procedure TFormJobProgressView.FormHide(Sender: TObject);
     346begin
     347  JobProgressView.Jobs.Clear;
     348  ReloadJobList;
     349end;
     350
     351procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     352begin
     353  CanClose := JobProgressView.Finished;
     354  JobProgressView.Terminate := True;
     355  Caption := SPleaseWait + STerminate;
     356end;
     357
     358
     359{ TJobProgressView }
     360
     361function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     362  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     363begin
     364  Result := TJob.Create;
     365  Result.ProgressView := Self;
     366  Result.Title := Title;
     367  Result.Method := Method;
     368  Result.NoThreaded := NoThreaded;
     369  Result.WaitFor := WaitFor;
     370  Result.Progress.Max := 100;
     371  Result.Progress.Reset;
     372  Result.Progress.OnChange := JobProgressChange;
     373  Jobs.Add(Result);
    207374  //ReloadJobList;
    208375end;
    209376
    210 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    211 begin
    212   AutoClose := AAutoClose;
    213   StartJobs;
    214 end;
    215 
    216 procedure TJobProgressView.StartJobs;
     377procedure TJobProgressView.Start;
    217378var
    218379  I: Integer;
     
    229390    Form.MemoLog.Clear;
    230391
     392    Form.PanelText.Visible := False;
    231393    Form.LabelEstimatedTimePart.Visible := False;
    232394    Form.LabelEstimatedTimeTotal.Visible := False;
     
    258420      Form.ProgressBarPart.Visible := False;
    259421      //Show;
    260       ReloadJobList;
     422      Form.ReloadJobList;
    261423      Application.ProcessMessages;
    262424      if NoThreaded then begin
     
    296458    //if Visible then Hide;
    297459    Form.MemoLog.Lines.Assign(Log);
    298     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     460    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    299461      Form.Hide;
    300462    end;
    301     Clear;
     463    if not Form.Visible then Clear;
    302464    Form.Caption := SFinished;
    303465    //LabelEstimatedTimePart.Visible := False;
    304466    Finished := True;
    305467    CurrentJobIndex := -1;
    306     ReloadJobList;
    307   end;
    308 end;
    309 
    310 procedure TJobProgressView.UpdateHeight;
    311 var
    312   H: Integer;
    313   PanelOperationsVisible: Boolean;
    314   PanelOperationsHeight: Integer;
    315   PanelProgressVisible: Boolean;
    316   PanelProgressTotalVisible: Boolean;
    317   PanelLogVisible: Boolean;
    318 begin
    319   with Form do begin
    320   H := PanelOperationsTitle.Height;
    321   PanelOperationsVisible := Jobs.Count > 0;
    322   if PanelOperationsVisible <> PanelOperations.Visible then
    323     PanelOperations.Visible := PanelOperationsVisible;
    324   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    325   if PanelOperationsHeight <> PanelOperations.Height then
    326     PanelOperations.Height := PanelOperationsHeight;
    327   if PanelOperationsVisible then
    328     H := H + PanelOperations.Height;
    329 
    330   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    331   if PanelProgressVisible <> PanelProgress.Visible then
    332     PanelProgress.Visible := PanelProgressVisible;
    333   if PanelProgressVisible then
    334     H := H + PanelProgress.Height;
    335   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    336   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    337     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    338   if PanelProgressTotalVisible then
    339     H := H + PanelProgressTotal.Height;
    340   Constraints.MinHeight := H;
    341   PanelLogVisible := MemoLog.Lines.Count > 0;
    342   if PanelLogVisible <> PanelLog.Visible then
    343     PanelLog.Visible := PanelLogVisible;
    344   if PanelLogVisible then
    345     H := H + MemoLogHeight;
    346   if Height <> H then Height := H;
     468    Form.ReloadJobList;
    347469  end;
    348470end;
     
    352474  if Assigned(FOnOwnerDraw) then
    353475    FOnOwnerDraw(Self);
    354 end;
    355 
    356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    357 var
    358   ProgressBarPartVisible: Boolean;
    359   ProgressBarTotalVisible: Boolean;
    360 begin
    361   JobProgressView.UpdateProgress;
    362   if Visible and (not ProgressBarPart.Visible) and
    363   Assigned(JobProgressView.CurrentJob) and
    364   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    365     ProgressBarPartVisible := True;
    366     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    367       ProgressBarPart.Visible := ProgressBarPartVisible;
    368     ProgressBarTotalVisible := True;
    369     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    370       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    371   end;
    372   if not Visible then begin
    373     TimerUpdate.Interval := UpdateInterval;
    374     if not JobProgressView.OwnerDraw then Show;
    375   end;
    376 end;
    377 
    378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    379 begin
    380 end;
    381 
    382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    383 begin
    384   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    385   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    386     Item.Caption := Title;
    387     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    388       else if Finished then Item.ImageIndex := 0
    389       else Item.ImageIndex := 2;
    390     Item.Data := JobProgressView.Jobs[Item.Index];
    391   end;
    392 end;
    393 
    394 procedure TFormJobProgressView.FormClose(Sender: TObject;
    395   var CloseAction: TCloseAction);
    396 begin
    397   ListViewJobs.Clear;
    398 end;
    399 
    400 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    401 begin
    402   Caption := SPleaseWait;
    403   try
    404     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    405     //  DirectorySeparator + 'horse.avi';
    406     //Animate1.Active := True;
    407   except
    408 
    409   end;
    410476end;
    411477
     
    426492    Sleep(Quantum);
    427493  end;
    428 end;
    429 
    430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    431 begin
    432   CanClose := JobProgressView.Finished;
    433   JobProgressView.Terminate := True;
    434   Caption := SPleaseWait + STerminate;
    435494end;
    436495
     
    490549end;
    491550
    492 procedure TJobProgressView.ReloadJobList;
    493 begin
    494   UpdateHeight;
    495   // Workaround for not showing first line
    496   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    497   Form.ListViewJobs.Refresh;
    498 
    499   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    500     Form.ListViewJobs.Items.Count := Jobs.Count;
    501   Form.ListViewJobs.Refresh;
    502   //Application.ProcessMessages;
    503 end;
    504 
    505551constructor TJobProgressView.Create(TheOwner: TComponent);
    506552begin
    507553  inherited;
    508554  if not (csDesigning in ComponentState) then begin
    509     Form := TFormJobProgressView.Create(Self);
    510     Form.JobProgressView := Self;
    511   end;
    512   Jobs := TObjectList.Create;
     555    FForm := TFormJobProgressView.Create(Self);
     556    FForm.JobProgressView := Self;
     557  end;
     558  Jobs := TJobs.Create;
    513559  Log := TStringList.Create;
    514560  //PanelOperationsTitle.Height := 80;
    515   ShowDelay := 0; //1000; // ms
     561  AutoClose := True;
     562  ShowDelay := 0;
    516563end;
    517564
     
    519566begin
    520567  Jobs.Clear;
     568  Log.Clear;
    521569  //ReloadJobList;
    522570end;
     
    528576  inherited;
    529577end;
     578
     579{ TProgress }
    530580
    531581procedure TProgress.SetMax(const AValue: Integer);
     
    536586    if FMax < 1 then FMax := 1;
    537587    if FValue >= FMax then FValue := FMax;
     588  finally
     589    FLock.Release;
     590  end;
     591end;
     592
     593procedure TProgress.SetText(AValue: string);
     594begin
     595  try
     596    FLock.Acquire;
     597    if FText = AValue then Exit;
     598    FText := AValue;
    538599  finally
    539600    FLock.Release;
     
    563624end;
    564625
    565 { TProgress }
    566 
    567626procedure TProgress.Increment;
    568627begin
Note: See TracChangeset for help on using the changeset viewer.