Changeset 38 for trunk/Components/Common/UJobProgressView.pas
- Timestamp:
- Apr 18, 2019, 3:34:38 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Components/Common/UJobProgressView.pas
r34 r38 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 … … 13 13 EstimatedTimeShowTreshold = 4; 14 14 EstimatedTimeShowTresholdTotal = 1; 15 MemoLogHeight = 200;16 15 UpdateInterval = 100; // ms 17 16 … … 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 … … 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; … … 69 71 end; 70 72 73 TJobs = class(TObjectList) 74 end; 75 71 76 TJobThread = class(TListedThread) 72 77 procedure Execute; override; … … 80 85 TFormJobProgressView = class(TForm) 81 86 ImageList1: TImageList; 87 LabelText: TLabel; 82 88 Label2: TLabel; 83 89 LabelOperation: TLabel; … … 86 92 ListViewJobs: TListView; 87 93 MemoLog: TMemo; 94 PanelText: TPanel; 88 95 PanelProgressTotal: TPanel; 89 96 PanelOperationsTitle: TPanel; … … 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); … … 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; … … 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; … … 132 140 destructor Destroy; override; 133 141 procedure Clear; 134 procedureAddJob(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 … … 166 175 STotalEstimatedTime = 'Total estimated time: %s'; 167 176 SFinished = 'Finished'; 168 SOperations = 'Operations ';177 SOperations = 'Operations:'; 169 178 170 179 procedure Register; … … 172 181 RegisterComponents('Common', [TJobProgressView]); 173 182 end; 183 184 { TJobThread } 174 185 175 186 procedure TJobThread.Execute; … … 190 201 end; 191 202 192 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 193 NoThreaded: Boolean = False; WaitFor: Boolean = False); 203 { TFormJobProgressView } 204 205 procedure TFormJobProgressView.UpdateHeight; 194 206 var 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); 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); 207 369 //ReloadJobList; 208 370 end; 209 371 210 procedure TJobProgressView.Start(AAutoClose: Boolean = True); 211 begin 212 AutoClose := AAutoClose; 213 StartJobs; 214 end; 215 216 procedure TJobProgressView.StartJobs; 372 procedure TJobProgressView.Start; 217 373 var 218 374 I: Integer; … … 229 385 Form.MemoLog.Clear; 230 386 387 Form.PanelText.Visible := False; 231 388 Form.LabelEstimatedTimePart.Visible := False; 232 389 Form.LabelEstimatedTimeTotal.Visible := False; … … 258 415 Form.ProgressBarPart.Visible := False; 259 416 //Show; 260 ReloadJobList;417 Form.ReloadJobList; 261 418 Application.ProcessMessages; 262 419 if NoThreaded then begin … … 296 453 //if Visible then Hide; 297 454 Form.MemoLog.Lines.Assign(Log); 298 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin455 if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin 299 456 Form.Hide; 300 457 end; 301 Clear;458 if not Form.Visible then Clear; 302 459 Form.Caption := SFinished; 303 460 //LabelEstimatedTimePart.Visible := False; 304 461 Finished := True; 305 462 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; 463 Form.ReloadJobList; 347 464 end; 348 465 end; … … 352 469 if Assigned(FOnOwnerDraw) then 353 470 FOnOwnerDraw(Self); 354 end;355 356 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);357 var358 ProgressBarPartVisible: Boolean;359 ProgressBarTotalVisible: Boolean;360 begin361 JobProgressView.UpdateProgress;362 if Visible and (not ProgressBarPart.Visible) and363 Assigned(JobProgressView.CurrentJob) and364 (JobProgressView.CurrentJob.Progress.Value > 0) then begin365 ProgressBarPartVisible := True;366 if ProgressBarPartVisible <> ProgressBarPart.Visible then367 ProgressBarPart.Visible := ProgressBarPartVisible;368 ProgressBarTotalVisible := True;369 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then370 ProgressBarTotal.Visible := ProgressBarTotalVisible;371 end;372 if not Visible then begin373 TimerUpdate.Interval := UpdateInterval;374 if not JobProgressView.OwnerDraw then Show;375 end;376 end;377 378 procedure TFormJobProgressView.FormDestroy(Sender:TObject);379 begin380 end;381 382 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);383 begin384 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then385 with TJob(JobProgressView.Jobs[Item.Index]) do begin386 Item.Caption := Title;387 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1388 else if Finished then Item.ImageIndex := 0389 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 begin397 ListViewJobs.Clear;398 end;399 400 procedure TFormJobProgressView.FormCreate(Sender: TObject);401 begin402 Caption := SPleaseWait;403 try404 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +405 // DirectorySeparator + 'horse.avi';406 //Animate1.Active := True;407 except408 409 end;410 471 end; 411 472 … … 426 487 Sleep(Quantum); 427 488 end; 428 end;429 430 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);431 begin432 CanClose := JobProgressView.Finished;433 JobProgressView.Terminate := True;434 Caption := SPleaseWait + STerminate;435 489 end; 436 490 … … 490 544 end; 491 545 492 procedure TJobProgressView.ReloadJobList;493 begin494 UpdateHeight;495 // Workaround for not showing first line496 Form.ListViewJobs.Items.Count := Jobs.Count + 1;497 Form.ListViewJobs.Refresh;498 499 if Form.ListViewJobs.Items.Count <> Jobs.Count then500 Form.ListViewJobs.Items.Count := Jobs.Count;501 Form.ListViewJobs.Refresh;502 //Application.ProcessMessages;503 end;504 505 546 constructor TJobProgressView.Create(TheOwner: TComponent); 506 547 begin 507 548 inherited; 508 549 if not (csDesigning in ComponentState) then begin 509 F orm := TFormJobProgressView.Create(Self);510 F orm.JobProgressView := Self;511 end; 512 Jobs := T ObjectList.Create;550 FForm := TFormJobProgressView.Create(Self); 551 FForm.JobProgressView := Self; 552 end; 553 Jobs := TJobs.Create; 513 554 Log := TStringList.Create; 514 555 //PanelOperationsTitle.Height := 80; 515 ShowDelay := 0; //1000; // ms 556 AutoClose := True; 557 ShowDelay := 0; 516 558 end; 517 559 … … 519 561 begin 520 562 Jobs.Clear; 563 Log.Clear; 521 564 //ReloadJobList; 522 565 end; … … 528 571 inherited; 529 572 end; 573 574 { TProgress } 530 575 531 576 procedure TProgress.SetMax(const AValue: Integer); … … 536 581 if FMax < 1 then FMax := 1; 537 582 if FValue >= FMax then FValue := FMax; 583 finally 584 FLock.Release; 585 end; 586 end; 587 588 procedure TProgress.SetText(AValue: string); 589 begin 590 try 591 FLock.Acquire; 592 if FText = AValue then Exit; 593 FText := AValue; 538 594 finally 539 595 FLock.Release; … … 563 619 end; 564 620 565 { TProgress }566 567 621 procedure TProgress.Increment; 568 622 begin
Note:
See TracChangeset
for help on using the changeset viewer.