Ignore:
Timestamp:
Aug 31, 2018, 3:38:01 PM (6 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package files.
  • Fixed: Autosize coolbar during main form resize.
File:
1 edited

Legend:

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

    r181 r200  
    77uses
    88  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     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';
     177  SOperations = 'Operations:';
    168178
    169179procedure Register;
     
    171181  RegisterComponents('Common', [TJobProgressView]);
    172182end;
     183
     184{ TJobThread }
    173185
    174186procedure TJobThread.Execute;
     
    189201end;
    190202
    191 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    192   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203{ TFormJobProgressView }
     204
     205procedure TFormJobProgressView.UpdateHeight;
    193206var
    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);
     207  H: Integer;
     208  PanelOperationsVisible: Boolean;
     209  PanelOperationsHeight: Integer;
     210  PanelProgressVisible: Boolean;
     211  PanelProgressTotalVisible: Boolean;
     212  PanelLogVisible: Boolean;
     213  MemoLogHeight: Integer = 200;
     214  I: Integer;
     215  ItemRect: TRect;
     216  MaxH: Integer;
     217begin
     218    H := PanelOperationsTitle.Height;
     219    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     220    if PanelOperationsVisible <> PanelOperations.Visible then
     221      PanelOperations.Visible := PanelOperationsVisible;
     222    if ListViewJobs.Items.Count > 0 then begin
     223      Maxh := 0;
     224      for I := 0 to ListViewJobs.Items.Count - 1 do
     225      begin
     226        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     227        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     228      end;
     229      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     230    end else PanelOperationsHeight := Scale96ToScreen(8);
     231    if PanelOperationsHeight <> PanelOperations.Height then
     232      PanelOperations.Height := PanelOperationsHeight;
     233    if PanelOperationsVisible then
     234      H := H + PanelOperations.Height;
     235
     236    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     237    if PanelProgressVisible <> PanelProgress.Visible then
     238      PanelProgress.Visible := PanelProgressVisible;
     239    if PanelProgressVisible then
     240      H := H + PanelProgress.Height;
     241    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     242    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     243      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     244    if PanelProgressTotalVisible then
     245      H := H + PanelProgressTotal.Height;
     246    Constraints.MinHeight := H;
     247    PanelLogVisible := MemoLog.Lines.Count > 0;
     248    if PanelLogVisible <> PanelLog.Visible then
     249      PanelLog.Visible := PanelLogVisible;
     250    if PanelLogVisible then
     251      H := H + Scale96ToScreen(MemoLogHeight);
     252    if PanelText.Visible then
     253      H := H + PanelText.Height;
     254    if Height <> H then begin
     255      Height := H;
     256      Top := (Screen.Height - H) div 2;
     257    end;
     258end;
     259
     260procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     261var
     262  ProgressBarPartVisible: Boolean;
     263  ProgressBarTotalVisible: Boolean;
     264begin
     265  JobProgressView.UpdateProgress;
     266  if Visible and (not ProgressBarPart.Visible) and
     267  Assigned(JobProgressView.CurrentJob) and
     268  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     269    ProgressBarPartVisible := True;
     270    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     271      ProgressBarPart.Visible := ProgressBarPartVisible;
     272    ProgressBarTotalVisible := True;
     273    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     274      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     275  end;
     276  if not Visible then begin
     277    TimerUpdate.Interval := UpdateInterval;
     278    if not JobProgressView.OwnerDraw then Show;
     279  end;
     280  if Assigned(JobProgressView.CurrentJob) then begin
     281    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     282    if LabelText.Caption <> '' then begin
     283      PanelText.Visible := True;
     284      UpdateHeight;
     285    end;
     286  end;
     287end;
     288
     289procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     290begin
     291end;
     292
     293procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     294begin
     295  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     296  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     297    Item.Caption := Title;
     298    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     299      else if Finished then Item.ImageIndex := 0
     300      else Item.ImageIndex := 2;
     301    Item.Data := JobProgressView.Jobs[Item.Index];
     302  end;
     303end;
     304
     305procedure TFormJobProgressView.FormClose(Sender: TObject;
     306  var CloseAction: TCloseAction);
     307begin
     308end;
     309
     310procedure TFormJobProgressView.FormCreate(Sender: TObject);
     311begin
     312  Caption := SPleaseWait;
     313  try
     314    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     315    //  DirectorySeparator + 'horse.avi';
     316    //Animate1.Active := True;
     317  except
     318
     319  end;
     320end;
     321
     322procedure TFormJobProgressView.ReloadJobList;
     323begin
     324  // Workaround for not showing first line
     325  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     326  //Form.ListViewJobs.Refresh;
     327
     328  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     329    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     330  ListViewJobs.Refresh;
     331  Application.ProcessMessages;
     332  UpdateHeight;
     333end;
     334
     335procedure TFormJobProgressView.FormShow(Sender: TObject);
     336begin
     337  ReloadJobList;
     338end;
     339
     340procedure TFormJobProgressView.FormHide(Sender: TObject);
     341begin
     342  JobProgressView.Jobs.Clear;
     343  ReloadJobList;
     344end;
     345
     346procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     347begin
     348  CanClose := JobProgressView.Finished;
     349  JobProgressView.Terminate := True;
     350  Caption := SPleaseWait + STerminate;
     351end;
     352
     353
     354{ TJobProgressView }
     355
     356function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     357  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     358begin
     359  Result := TJob.Create;
     360  Result.ProgressView := Self;
     361  Result.Title := Title;
     362  Result.Method := Method;
     363  Result.NoThreaded := NoThreaded;
     364  Result.WaitFor := WaitFor;
     365  Result.Progress.Max := 100;
     366  Result.Progress.Reset;
     367  Result.Progress.OnChange := JobProgressChange;
     368  Jobs.Add(Result);
    206369  //ReloadJobList;
    207370end;
    208371
    209 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    210 begin
    211   AutoClose := AAutoClose;
    212   StartJobs;
    213 end;
    214 
    215 procedure TJobProgressView.StartJobs;
     372procedure TJobProgressView.Start;
    216373var
    217374  I: Integer;
     
    228385    Form.MemoLog.Clear;
    229386
     387    Form.PanelText.Visible := False;
    230388    Form.LabelEstimatedTimePart.Visible := False;
    231389    Form.LabelEstimatedTimeTotal.Visible := False;
     
    257415      Form.ProgressBarPart.Visible := False;
    258416      //Show;
    259       ReloadJobList;
     417      Form.ReloadJobList;
    260418      Application.ProcessMessages;
    261419      if NoThreaded then begin
     
    295453    //if Visible then Hide;
    296454    Form.MemoLog.Lines.Assign(Log);
    297     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     455    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    298456      Form.Hide;
    299457    end;
    300     Clear;
     458    if not Form.Visible then Clear;
    301459    Form.Caption := SFinished;
    302460    //LabelEstimatedTimePart.Visible := False;
    303461    Finished := True;
    304462    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;
     463    Form.ReloadJobList;
    346464  end;
    347465end;
     
    351469  if Assigned(FOnOwnerDraw) then
    352470    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;
    409471end;
    410472
     
    425487    Sleep(Quantum);
    426488  end;
    427 end;
    428 
    429 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    430 begin
    431   CanClose := JobProgressView.Finished;
    432   JobProgressView.Terminate := True;
    433   Caption := SPleaseWait + STerminate;
    434489end;
    435490
     
    489544end;
    490545
    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 
    504546constructor TJobProgressView.Create(TheOwner: TComponent);
    505547begin
    506548  inherited;
    507549  if not (csDesigning in ComponentState) then begin
    508     Form := TFormJobProgressView.Create(Self);
    509     Form.JobProgressView := Self;
    510   end;
    511   Jobs := TObjectList.Create;
     550    FForm := TFormJobProgressView.Create(Self);
     551    FForm.JobProgressView := Self;
     552  end;
     553  Jobs := TJobs.Create;
    512554  Log := TStringList.Create;
    513555  //PanelOperationsTitle.Height := 80;
    514   ShowDelay := 0; //1000; // ms
     556  AutoClose := True;
     557  ShowDelay := 0;
    515558end;
    516559
     
    518561begin
    519562  Jobs.Clear;
     563  Log.Clear;
    520564  //ReloadJobList;
    521565end;
     
    527571  inherited;
    528572end;
     573
     574{ TProgress }
    529575
    530576procedure TProgress.SetMax(const AValue: Integer);
     
    535581    if FMax < 1 then FMax := 1;
    536582    if FValue >= FMax then FValue := FMax;
     583  finally
     584    FLock.Release;
     585  end;
     586end;
     587
     588procedure TProgress.SetText(AValue: string);
     589begin
     590  try
     591    FLock.Acquire;
     592    if FText = AValue then Exit;
     593    FText := AValue;
    537594  finally
    538595    FLock.Release;
     
    562619end;
    563620
    564 { TProgress }
    565 
    566621procedure TProgress.Increment;
    567622begin
Note: See TracChangeset for help on using the changeset viewer.