« back to all changes in this revision
Viewing changes to Packages/Common/UJobProgressView.pas
- browse files at revision 179
- compare with another revision
- download diff
- download tarball
- view history from revision 179
- Committer: chronos
- Date: 2018-08-31 13:38:01 UTC
- Revision ID: svn-v4:555d2374-d668-43ce-8d1e-0714718c3872:trunk:200
* Modified: Updated Common package files.
* Fixed: Autosize coolbar during main form resize.
* Fixed: Autosize coolbar during main form resize.
- files modified:
- Forms/UFormMain.lfm
added
removed
Packages/Common/UJobProgressView.pas
6
6
7
7
uses
8
8
SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
9
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
9
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
10
10
DateUtils;
11
11
12
12
const
13
13
EstimatedTimeShowTreshold = 4;
14
14
EstimatedTimeShowTresholdTotal = 1;
15
MemoLogHeight = 200;
16
15
UpdateInterval = 100; // ms
17
16
18
17
type
23
22
private
24
23
FLock: TCriticalSection;
25
24
FOnChange: TNotifyEvent;
25
FText: string;
26
26
FValue: Integer;
27
27
FMax: Integer;
28
28
procedure SetMax(const AValue: Integer);
29
procedure SetText(AValue: string);
29
30
procedure SetValue(const AValue: Integer);
30
31
public
31
32
procedure Increment;
34
35
destructor Destroy; override;
35
36
property Value: Integer read FValue write SetValue;
36
37
property Max: Integer read FMax write SetMax;
38
property Text: string read FText write SetText;
37
39
property OnChange: TNotifyEvent read FOnChange write FOnChange;
38
40
end;
39
41
68
70
property Terminate: Boolean read FTerminate write SetTerminate;
69
71
end;
70
72
73
TJobs = class(TObjectList)
74
end;
75
71
76
TJobThread = class(TListedThread)
72
77
procedure Execute; override;
73
78
public
79
84
80
85
TFormJobProgressView = class(TForm)
81
86
ImageList1: TImageList;
87
LabelText: TLabel;
82
88
Label2: TLabel;
83
89
LabelOperation: TLabel;
84
90
LabelEstimatedTimePart: TLabel;
85
91
LabelEstimatedTimeTotal: TLabel;
86
92
ListViewJobs: TListView;
87
93
MemoLog: TMemo;
94
PanelText: TPanel;
88
95
PanelProgressTotal: TPanel;
89
96
PanelOperationsTitle: TPanel;
90
97
PanelLog: TPanel;
93
100
ProgressBarPart: TProgressBar;
94
101
ProgressBarTotal: TProgressBar;
95
102
TimerUpdate: TTimer;
103
procedure FormHide(Sender: TObject);
104
procedure FormShow(Sender: TObject);
105
procedure ReloadJobList;
96
106
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
97
107
procedure FormDestroy(Sender: TObject);
98
108
procedure ListViewJobsData(Sender: TObject; Item: TListItem);
99
109
procedure TimerUpdateTimer(Sender: TObject);
100
110
procedure FormCreate(Sender: TObject);
101
111
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
112
procedure UpdateHeight;
102
113
public
103
114
JobProgressView: TJobProgressView;
104
115
end;
117
128
FormList: TList;
118
129
TotalStartTime: TDateTime;
119
130
Log: TStringList;
131
FForm: TFormJobProgressView;
120
132
procedure SetTerminate(const AValue: Boolean);
121
133
procedure UpdateProgress;
122
procedure ReloadJobList;
123
procedure StartJobs;
124
procedure UpdateHeight;
125
134
procedure JobProgressChange(Sender: TObject);
126
135
public
127
Form: TFormJobProgressView;
128
Jobs: TObjectList; // TListObject<TJob>
136
Jobs: TJobs;
129
137
CurrentJob: TJob;
130
138
CurrentJobIndex: Integer;
131
139
constructor Create(TheOwner: TComponent); override;
132
140
destructor Destroy; override;
133
141
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;
137
145
procedure Stop;
138
146
procedure TermSleep(Delay: Integer);
147
property Form: TFormJobProgressView read FForm;
139
148
property Terminate: Boolean read FTerminate write SetTerminate;
140
149
published
141
150
property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw;
165
174
SEstimatedTime = 'Estimated time: %s';
166
175
STotalEstimatedTime = 'Total estimated time: %s';
167
176
SFinished = 'Finished';
177
SOperations = 'Operations:';
168
178
169
179
procedure Register;
170
180
begin
171
181
RegisterComponents('Common', [TJobProgressView]);
172
182
end;
173
183
184
{ TJobThread }
185
174
186
procedure TJobThread.Execute;
175
187
begin
176
188
try
188
200
end;
189
201
end;
190
202
191
procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
192
NoThreaded: Boolean = False; WaitFor: Boolean = False);
193
var
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);
203
{ TFormJobProgressView }
204
205
procedure TFormJobProgressView.UpdateHeight;
206
var
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;
217
begin
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;
258
end;
259
260
procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
261
var
262
ProgressBarPartVisible: Boolean;
263
ProgressBarTotalVisible: Boolean;
264
begin
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;
287
end;
288
289
procedure TFormJobProgressView.FormDestroy(Sender:TObject);
290
begin
291
end;
292
293
procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
294
begin
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;
303
end;
304
305
procedure TFormJobProgressView.FormClose(Sender: TObject;
306
var CloseAction: TCloseAction);
307
begin
308
end;
309
310
procedure TFormJobProgressView.FormCreate(Sender: TObject);
311
begin
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;
320
end;
321
322
procedure TFormJobProgressView.ReloadJobList;
323
begin
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;
333
end;
334
335
procedure TFormJobProgressView.FormShow(Sender: TObject);
336
begin
337
ReloadJobList;
338
end;
339
340
procedure TFormJobProgressView.FormHide(Sender: TObject);
341
begin
342
JobProgressView.Jobs.Clear;
343
ReloadJobList;
344
end;
345
346
procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
347
begin
348
CanClose := JobProgressView.Finished;
349
JobProgressView.Terminate := True;
350
Caption := SPleaseWait + STerminate;
351
end;
352
353
354
{ TJobProgressView }
355
356
function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
357
NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
358
begin
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);
206
369
//ReloadJobList;
207
370
end;
208
371
209
procedure TJobProgressView.Start(AAutoClose: Boolean = True);
210
begin
211
AutoClose := AAutoClose;
212
StartJobs;
213
end;
214
215
procedure TJobProgressView.StartJobs;
372
procedure TJobProgressView.Start;
216
373
var
217
374
I: Integer;
218
375
begin
227
384
Log.Clear;
228
385
Form.MemoLog.Clear;
229
386
387
Form.PanelText.Visible := False;
230
388
Form.LabelEstimatedTimePart.Visible := False;
231
389
Form.LabelEstimatedTimeTotal.Visible := False;
232
390
256
414
Form.ProgressBarPart.Position := 0;
257
415
Form.ProgressBarPart.Visible := False;
258
416
//Show;
259
ReloadJobList;
417
Form.ReloadJobList;
260
418
Application.ProcessMessages;
261
419
if NoThreaded then begin
262
420
Thread := nil;
294
452
Screen.EnableForms(FormList);
295
453
//if Visible then Hide;
296
454
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
298
456
Form.Hide;
299
457
end;
300
Clear;
458
if not Form.Visible then Clear;
301
459
Form.Caption := SFinished;
302
460
//LabelEstimatedTimePart.Visible := False;
303
461
Finished := True;
304
462
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;
346
464
end;
347
465
end;
348
466
352
470
FOnOwnerDraw(Self);
353
471
end;
354
472
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;
409
end;
410
411
473
procedure TJobProgressView.Stop;
412
474
begin
413
475
Terminate := True;
426
488
end;
427
489
end;
428
490
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
436
491
procedure TJobProgressView.SetTerminate(const AValue: Boolean);
437
492
var
438
493
I: Integer;
488
543
end;
489
544
end;
490
545
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
504
546
constructor TJobProgressView.Create(TheOwner: TComponent);
505
547
begin
506
548
inherited;
507
549
if not (csDesigning in ComponentState) then begin
508
Form := TFormJobProgressView.Create(Self);
509
Form.JobProgressView := Self;
550
FForm := TFormJobProgressView.Create(Self);
551
FForm.JobProgressView := Self;
510
552
end;
511
Jobs := TObjectList.Create;
553
Jobs := TJobs.Create;
512
554
Log := TStringList.Create;
513
555
//PanelOperationsTitle.Height := 80;
514
ShowDelay := 0; //1000; // ms
556
AutoClose := True;
557
ShowDelay := 0;
515
558
end;
516
559
517
560
procedure TJobProgressView.Clear;
518
561
begin
519
562
Jobs.Clear;
563
Log.Clear;
520
564
//ReloadJobList;
521
565
end;
522
566
527
571
inherited;
528
572
end;
529
573
574
{ TProgress }
575
530
576
procedure TProgress.SetMax(const AValue: Integer);
531
577
begin
532
578
try
539
585
end;
540
586
end;
541
587
588
procedure TProgress.SetText(AValue: string);
589
begin
590
try
591
FLock.Acquire;
592
if FText = AValue then Exit;
593
FText := AValue;
594
finally
595
FLock.Release;
596
end;
597
end;
598
542
599
procedure TProgress.SetValue(const AValue: Integer);
543
600
var
544
601
Change: Boolean;
561
618
end;
562
619
end;
563
620
564
{ TProgress }
565
566
621
procedure TProgress.Increment;
567
622
begin
568
623
try
Loggerhead is a web-based interface for Breezy
Version: 2.0.1