Ignore:
Timestamp:
Jun 4, 2024, 12:22:49 AM (5 months ago)
Author:
chronos
Message:
  • Modified: Removed U prefix from unit names.
  • Modified: Updated Common package.
File:
1 moved

Legend:

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

    r74 r75  
    1 unit UJobProgressView;
    2 
    3 {$MODE Delphi}
     1unit JobProgressView;
    42
    53interface
     
    75uses
    86  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     7  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math,
    108  DateUtils;
    119
     
    1311  EstimatedTimeShowTreshold = 4;
    1412  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1613  UpdateInterval = 100; // ms
    1714
     
    2421    FLock: TCriticalSection;
    2522    FOnChange: TNotifyEvent;
     23    FText: string;
    2624    FValue: Integer;
    2725    FMax: Integer;
    2826    procedure SetMax(const AValue: Integer);
     27    procedure SetText(AValue: string);
    2928    procedure SetValue(const AValue: Integer);
    3029  public
     
    3534    property Value: Integer read FValue write SetValue;
    3635    property Max: Integer read FMax write SetMax;
     36    property Text: string read FText write SetText;
    3737    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3838  end;
     
    6969  end;
    7070
     71  TJobs = class(TObjectList<TJob>)
     72  end;
     73
    7174  TJobThread = class(TListedThread)
    7275    procedure Execute; override;
     
    8083  TFormJobProgressView = class(TForm)
    8184    ImageList1: TImageList;
     85    LabelText: TLabel;
    8286    Label2: TLabel;
    8387    LabelOperation: TLabel;
     
    8690    ListViewJobs: TListView;
    8791    MemoLog: TMemo;
     92    PanelText: TPanel;
    8893    PanelProgressTotal: TPanel;
    8994    PanelOperationsTitle: TPanel;
     
    9499    ProgressBarTotal: TProgressBar;
    95100    TimerUpdate: TTimer;
     101    procedure FormHide(Sender: TObject);
     102    procedure FormShow(Sender: TObject);
     103    procedure ReloadJobList;
    96104    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97     procedure FormDestroy(Sender: TObject);
    98105    procedure ListViewJobsData(Sender: TObject; Item: TListItem);
    99106    procedure TimerUpdateTimer(Sender: TObject);
    100107    procedure FormCreate(Sender: TObject);
    101108    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     109    procedure UpdateHeight;
    102110  public
    103111    JobProgressView: TJobProgressView;
     
    118126    TotalStartTime: TDateTime;
    119127    Log: TStringList;
     128    FForm: TFormJobProgressView;
    120129    procedure SetTerminate(const AValue: Boolean);
    121130    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125131    procedure JobProgressChange(Sender: TObject);
    126132  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     133    Jobs: TJobs;
    129134    CurrentJob: TJob;
    130135    CurrentJobIndex: Integer;
     
    132137    destructor Destroy; override;
    133138    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     139    function AddJob(Title: string; Method: TJobProgressViewMethod;
     140      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     141    procedure Start;
    137142    procedure Stop;
    138143    procedure TermSleep(Delay: Integer);
     144    property Form: TFormJobProgressView read FForm;
    139145    property Terminate: Boolean read FTerminate write SetTerminate;
    140146  published
     
    148154  end;
    149155
    150   //var
    151   //  FormJobProgressView: TFormJobProgressView;
    152 
    153156procedure Register;
    154157
    155158resourcestring
    156159  SExecuted = 'Executed';
     160
    157161
    158162implementation
     
    172176end;
    173177
     178{ TJobThread }
     179
    174180procedure TJobThread.Execute;
    175181begin
    176182  try
    177183    try
    178       //raise Exception.Create('Exception in job');
    179184      ProgressView.CurrentJob.Method(Job);
    180185    except
     
    189194end;
    190195
    191 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    192   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     196{ TFormJobProgressView }
     197
     198procedure TFormJobProgressView.UpdateHeight;
    193199var
    194   NewJob: TJob;
    195 begin
    196   NewJob := TJob.Create;
    197   NewJob.ProgressView := Self;
    198   NewJob.Title := Title;
    199   NewJob.Method := Method;
    200   NewJob.NoThreaded := NoThreaded;
    201   NewJob.WaitFor := WaitFor;
    202   NewJob.Progress.Max := 100;
    203   NewJob.Progress.Reset;
    204   NewJob.Progress.OnChange := JobProgressChange;
    205   Jobs.Add(NewJob);
     200  H: Integer;
     201  PanelOperationsVisible: Boolean;
     202  PanelOperationsHeight: Integer;
     203  PanelProgressVisible: Boolean;
     204  PanelProgressTotalVisible: Boolean;
     205  PanelLogVisible: Boolean;
     206  MemoLogHeight: Integer = 200;
     207  I: Integer;
     208  ItemRect: TRect;
     209  MaxH: Integer;
     210begin
     211    H := PanelOperationsTitle.Height;
     212    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     213    if PanelOperationsVisible <> PanelOperations.Visible then
     214      PanelOperations.Visible := PanelOperationsVisible;
     215    if ListViewJobs.Items.Count > 0 then begin
     216      Maxh := 0;
     217      for I := 0 to ListViewJobs.Items.Count - 1 do
     218      begin
     219        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     220        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     221      end;
     222      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     223    end else PanelOperationsHeight := Scale96ToScreen(8);
     224    if PanelOperationsHeight <> PanelOperations.Height then
     225      PanelOperations.Height := PanelOperationsHeight;
     226    if PanelOperationsVisible then
     227      H := H + PanelOperations.Height;
     228
     229    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     230    if PanelProgressVisible <> PanelProgress.Visible then
     231      PanelProgress.Visible := PanelProgressVisible;
     232    if PanelProgressVisible then
     233      H := H + PanelProgress.Height;
     234    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     235    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     236      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     237    if PanelProgressTotalVisible then
     238      H := H + PanelProgressTotal.Height;
     239    Constraints.MinHeight := H;
     240    PanelLogVisible := MemoLog.Lines.Count > 0;
     241    if PanelLogVisible <> PanelLog.Visible then
     242      PanelLog.Visible := PanelLogVisible;
     243    if PanelLogVisible then
     244      H := H + Scale96ToScreen(MemoLogHeight);
     245    if PanelText.Visible then
     246      H := H + PanelText.Height;
     247    if Height <> H then begin
     248      Height := H;
     249      Top := (Screen.Height - H) div 2;
     250    end;
     251end;
     252
     253procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     254var
     255  ProgressBarPartVisible: Boolean;
     256  ProgressBarTotalVisible: Boolean;
     257begin
     258  JobProgressView.UpdateProgress;
     259  if Visible and (not ProgressBarPart.Visible) and
     260  Assigned(JobProgressView.CurrentJob) and
     261  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     262    ProgressBarPartVisible := True;
     263    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     264      ProgressBarPart.Visible := ProgressBarPartVisible;
     265    ProgressBarTotalVisible := True;
     266    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     267      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     268  end;
     269  if not Visible then begin
     270    TimerUpdate.Interval := UpdateInterval;
     271    if not JobProgressView.OwnerDraw then Show;
     272  end;
     273  if Assigned(JobProgressView.CurrentJob) then begin
     274    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     275    if LabelText.Caption <> '' then begin
     276      PanelText.Visible := True;
     277      UpdateHeight;
     278    end;
     279  end;
     280end;
     281
     282procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     283begin
     284  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     285  with JobProgressView.Jobs[Item.Index] do begin
     286    Item.Caption := Title;
     287    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     288      else if Finished then Item.ImageIndex := 0
     289      else Item.ImageIndex := 2;
     290    Item.Data := JobProgressView.Jobs[Item.Index];
     291  end;
     292end;
     293
     294procedure TFormJobProgressView.FormClose(Sender: TObject;
     295  var CloseAction: TCloseAction);
     296begin
     297end;
     298
     299procedure TFormJobProgressView.FormCreate(Sender: TObject);
     300begin
     301  Caption := SPleaseWait;
     302  try
     303    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     304    //  DirectorySeparator + 'horse.avi';
     305    //Animate1.Active := True;
     306  except
     307
     308  end;
     309end;
     310
     311procedure TFormJobProgressView.ReloadJobList;
     312begin
     313  // Workaround for not showing first line
     314  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     315  //Form.ListViewJobs.Refresh;
     316
     317  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     318    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     319  ListViewJobs.Refresh;
     320  Application.ProcessMessages;
     321  UpdateHeight;
     322end;
     323
     324procedure TFormJobProgressView.FormShow(Sender: TObject);
     325begin
     326  ReloadJobList;
     327end;
     328
     329procedure TFormJobProgressView.FormHide(Sender: TObject);
     330begin
     331  JobProgressView.Jobs.Clear;
     332  ReloadJobList;
     333end;
     334
     335procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     336begin
     337  CanClose := JobProgressView.Finished;
     338  JobProgressView.Terminate := True;
     339  Caption := SPleaseWait + STerminate;
     340end;
     341
     342
     343{ TJobProgressView }
     344
     345function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     346  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     347begin
     348  Result := TJob.Create;
     349  Result.ProgressView := Self;
     350  Result.Title := Title;
     351  Result.Method := Method;
     352  Result.NoThreaded := NoThreaded;
     353  Result.WaitFor := WaitFor;
     354  Result.Progress.Max := 100;
     355  Result.Progress.Reset;
     356  Result.Progress.OnChange := JobProgressChange;
     357  Jobs.Add(Result);
    206358  //ReloadJobList;
    207359end;
    208360
    209 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    210 begin
    211   AutoClose := AAutoClose;
    212   StartJobs;
    213 end;
    214 
    215 procedure TJobProgressView.StartJobs;
     361procedure TJobProgressView.Start;
    216362var
    217363  I: Integer;
     
    228374    Form.MemoLog.Clear;
    229375
     376    Form.PanelText.Visible := False;
    230377    Form.LabelEstimatedTimePart.Visible := False;
    231378    Form.LabelEstimatedTimeTotal.Visible := False;
     
    248395    I := 0;
    249396    while I < Jobs.Count do
    250     with TJob(Jobs[I]) do begin
     397    with Jobs[I] do begin
    251398      CurrentJobIndex := I;
    252       CurrentJob := TJob(Jobs[I]);
     399      CurrentJob := Jobs[I];
    253400      JobProgressChange(Self);
    254401      StartTime := Now;
     
    257404      Form.ProgressBarPart.Visible := False;
    258405      //Show;
    259       ReloadJobList;
     406      Form.ReloadJobList;
    260407      Application.ProcessMessages;
    261408      if NoThreaded then begin
     
    263410        Method(CurrentJob);
    264411      end else begin
     412        Thread := TJobThread.Create(True);
    265413        try
    266           Thread := TJobThread.Create(True);
    267414          with Thread do begin
    268415            FreeOnTerminate := False;
     
    295442    //if Visible then Hide;
    296443    Form.MemoLog.Lines.Assign(Log);
    297     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     444    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    298445      Form.Hide;
    299446    end;
    300     Clear;
     447    if not Form.Visible then Clear;
    301448    Form.Caption := SFinished;
    302449    //LabelEstimatedTimePart.Visible := False;
    303450    Finished := True;
    304451    CurrentJobIndex := -1;
    305     ReloadJobList;
    306   end;
    307 end;
    308 
    309 procedure TJobProgressView.UpdateHeight;
    310 var
    311   H: Integer;
    312   PanelOperationsVisible: Boolean;
    313   PanelOperationsHeight: Integer;
    314   PanelProgressVisible: Boolean;
    315   PanelProgressTotalVisible: Boolean;
    316   PanelLogVisible: Boolean;
    317 begin
    318   with Form do begin
    319   H := PanelOperationsTitle.Height;
    320   PanelOperationsVisible := Jobs.Count > 0;
    321   if PanelOperationsVisible <> PanelOperations.Visible then
    322     PanelOperations.Visible := PanelOperationsVisible;
    323   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    324   if PanelOperationsHeight <> PanelOperations.Height then
    325     PanelOperations.Height := PanelOperationsHeight;
    326   if PanelOperationsVisible then
    327     H := H + PanelOperations.Height;
    328 
    329   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    330   if PanelProgressVisible <> PanelProgress.Visible then
    331     PanelProgress.Visible := PanelProgressVisible;
    332   if PanelProgressVisible then
    333     H := H + PanelProgress.Height;
    334   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    335   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    336     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    337   if PanelProgressTotalVisible then
    338     H := H + PanelProgressTotal.Height;
    339   Constraints.MinHeight := H;
    340   PanelLogVisible := MemoLog.Lines.Count > 0;
    341   if PanelLogVisible <> PanelLog.Visible then
    342     PanelLog.Visible := PanelLogVisible;
    343   if PanelLogVisible then
    344     H := H + MemoLogHeight;
    345   if Height <> H then Height := H;
     452    Form.ReloadJobList;
    346453  end;
    347454end;
     
    351458  if Assigned(FOnOwnerDraw) then
    352459    FOnOwnerDraw(Self);
    353 end;
    354 
    355 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    356 var
    357   ProgressBarPartVisible: Boolean;
    358   ProgressBarTotalVisible: Boolean;
    359 begin
    360   JobProgressView.UpdateProgress;
    361   if Visible and (not ProgressBarPart.Visible) and
    362   Assigned(JobProgressView.CurrentJob) and
    363   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    364     ProgressBarPartVisible := True;
    365     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    366       ProgressBarPart.Visible := ProgressBarPartVisible;
    367     ProgressBarTotalVisible := True;
    368     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    369       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    370   end;
    371   if not Visible then begin
    372     TimerUpdate.Interval := UpdateInterval;
    373     if not JobProgressView.OwnerDraw then Show;
    374   end;
    375 end;
    376 
    377 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    378 begin
    379 end;
    380 
    381 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    382 begin
    383   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    384   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    385     Item.Caption := Title;
    386     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    387       else if Finished then Item.ImageIndex := 0
    388       else Item.ImageIndex := 2;
    389     Item.Data := JobProgressView.Jobs[Item.Index];
    390   end;
    391 end;
    392 
    393 procedure TFormJobProgressView.FormClose(Sender: TObject;
    394   var CloseAction: TCloseAction);
    395 begin
    396   ListViewJobs.Clear;
    397 end;
    398 
    399 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    400 begin
    401   Caption := SPleaseWait;
    402   try
    403     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    404     //  DirectorySeparator + 'horse.avi';
    405     //Animate1.Active := True;
    406   except
    407 
    408   end;
    409460end;
    410461
     
    427478end;
    428479
    429 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    430 begin
    431   CanClose := JobProgressView.Finished;
    432   JobProgressView.Terminate := True;
    433   Caption := SPleaseWait + STerminate;
    434 end;
    435 
    436480procedure TJobProgressView.SetTerminate(const AValue: Boolean);
    437481var
     
    440484  if AValue = FTerminate then Exit;
    441485  for I := 0 to Jobs.Count - 1 do
    442     TJob(Jobs[I]).Terminate := AValue;
     486    Jobs[I].Terminate := AValue;
    443487  FTerminate := AValue;
    444488end;
     
    489533end;
    490534
    491 procedure TJobProgressView.ReloadJobList;
    492 begin
    493   UpdateHeight;
    494   // Workaround for not showing first line
    495   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    496   Form.ListViewJobs.Refresh;
    497 
    498   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    499     Form.ListViewJobs.Items.Count := Jobs.Count;
    500   Form.ListViewJobs.Refresh;
    501   //Application.ProcessMessages;
    502 end;
    503 
    504535constructor TJobProgressView.Create(TheOwner: TComponent);
    505536begin
    506537  inherited;
    507538  if not (csDesigning in ComponentState) then begin
    508     Form := TFormJobProgressView.Create(Self);
    509     Form.JobProgressView := Self;
    510   end;
    511   Jobs := TObjectList.Create;
     539    FForm := TFormJobProgressView.Create(Self);
     540    FForm.JobProgressView := Self;
     541  end;
     542  Jobs := TJobs.Create;
    512543  Log := TStringList.Create;
    513544  //PanelOperationsTitle.Height := 80;
    514   ShowDelay := 0; //1000; // ms
     545  AutoClose := True;
     546  ShowDelay := 0;
    515547end;
    516548
     
    518550begin
    519551  Jobs.Clear;
     552  Log.Clear;
    520553  //ReloadJobList;
    521554end;
     
    527560  inherited;
    528561end;
     562
     563{ TProgress }
    529564
    530565procedure TProgress.SetMax(const AValue: Integer);
     
    535570    if FMax < 1 then FMax := 1;
    536571    if FValue >= FMax then FValue := FMax;
     572  finally
     573    FLock.Release;
     574  end;
     575end;
     576
     577procedure TProgress.SetText(AValue: string);
     578begin
     579  try
     580    FLock.Acquire;
     581    if FText = AValue then Exit;
     582    FText := AValue;
    537583  finally
    538584    FLock.Release;
     
    562608end;
    563609
    564 { TProgress }
    565 
    566610procedure TProgress.Increment;
    567611begin
    568   try
    569     FLock.Acquire;
     612  FLock.Acquire;
     613  try
    570614    Value := Value + 1;
    571615  finally
     
    576620procedure TProgress.Reset;
    577621begin
    578   try
    579     FLock.Acquire;
     622  FLock.Acquire;
     623  try
    580624    FValue := 0;
    581625  finally
     
    593637begin
    594638  FLock.Free;
    595   inherited Destroy;
     639  inherited;
    596640end;
    597641
     
    624668destructor TJob.Destroy;
    625669begin
    626   Progress.Free;
     670  FreeAndNil(Progress);
    627671  inherited;
    628672end;
Note: See TracChangeset for help on using the changeset viewer.