Changeset 192 for trunk/Packages/Common/UJobProgressView.pas
- Timestamp:
- May 1, 2018, 10:18:03 AM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UJobProgressView.pas
r116 r192 6 6 7 7 uses 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, 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 function Scale96ToScreen(const ASize: Integer): Integer; 204 begin 205 Result := MulDiv(ASize, Screen.PixelsPerInch, 96); 206 end; 207 208 { TFormJobProgressView } 209 210 procedure TFormJobProgressView.UpdateHeight; 194 211 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); 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; 222 begin 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; 263 end; 264 265 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject); 266 var 267 ProgressBarPartVisible: Boolean; 268 ProgressBarTotalVisible: Boolean; 269 begin 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; 292 end; 293 294 procedure TFormJobProgressView.FormDestroy(Sender:TObject); 295 begin 296 end; 297 298 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem); 299 begin 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; 308 end; 309 310 procedure TFormJobProgressView.FormClose(Sender: TObject; 311 var CloseAction: TCloseAction); 312 begin 313 end; 314 315 procedure TFormJobProgressView.FormCreate(Sender: TObject); 316 begin 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; 325 end; 326 327 procedure TFormJobProgressView.ReloadJobList; 328 begin 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; 338 end; 339 340 procedure TFormJobProgressView.FormShow(Sender: TObject); 341 begin 342 ReloadJobList; 343 end; 344 345 procedure TFormJobProgressView.FormHide(Sender: TObject); 346 begin 347 JobProgressView.Jobs.Clear; 348 ReloadJobList; 349 end; 350 351 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 352 begin 353 CanClose := JobProgressView.Finished; 354 JobProgressView.Terminate := True; 355 Caption := SPleaseWait + STerminate; 356 end; 357 358 359 { TJobProgressView } 360 361 function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 362 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 363 begin 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); 207 374 //ReloadJobList; 208 375 end; 209 376 210 procedure TJobProgressView.Start(AAutoClose: Boolean = True); 211 begin 212 AutoClose := AAutoClose; 213 StartJobs; 214 end; 215 216 procedure TJobProgressView.StartJobs; 377 procedure TJobProgressView.Start; 217 378 var 218 379 I: Integer; … … 229 390 Form.MemoLog.Clear; 230 391 392 Form.PanelText.Visible := False; 231 393 Form.LabelEstimatedTimePart.Visible := False; 232 394 Form.LabelEstimatedTimeTotal.Visible := False; … … 258 420 Form.ProgressBarPart.Visible := False; 259 421 //Show; 260 ReloadJobList;422 Form.ReloadJobList; 261 423 Application.ProcessMessages; 262 424 if NoThreaded then begin … … 296 458 //if Visible then Hide; 297 459 Form.MemoLog.Lines.Assign(Log); 298 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin460 if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin 299 461 Form.Hide; 300 462 end; 301 Clear;463 if not Form.Visible then Clear; 302 464 Form.Caption := SFinished; 303 465 //LabelEstimatedTimePart.Visible := False; 304 466 Finished := True; 305 467 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; 347 469 end; 348 470 end; … … 352 474 if Assigned(FOnOwnerDraw) then 353 475 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 476 end; 411 477 … … 426 492 Sleep(Quantum); 427 493 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 494 end; 436 495 … … 490 549 end; 491 550 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 551 constructor TJobProgressView.Create(TheOwner: TComponent); 506 552 begin 507 553 inherited; 508 554 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;555 FForm := TFormJobProgressView.Create(Self); 556 FForm.JobProgressView := Self; 557 end; 558 Jobs := TJobs.Create; 513 559 Log := TStringList.Create; 514 560 //PanelOperationsTitle.Height := 80; 515 ShowDelay := 0; //1000; // ms 561 AutoClose := True; 562 ShowDelay := 0; 516 563 end; 517 564 … … 519 566 begin 520 567 Jobs.Clear; 568 Log.Clear; 521 569 //ReloadJobList; 522 570 end; … … 528 576 inherited; 529 577 end; 578 579 { TProgress } 530 580 531 581 procedure TProgress.SetMax(const AValue: Integer); … … 536 586 if FMax < 1 then FMax := 1; 537 587 if FValue >= FMax then FValue := FMax; 588 finally 589 FLock.Release; 590 end; 591 end; 592 593 procedure TProgress.SetText(AValue: string); 594 begin 595 try 596 FLock.Acquire; 597 if FText = AValue then Exit; 598 FText := AValue; 538 599 finally 539 600 FLock.Release; … … 563 624 end; 564 625 565 { TProgress }566 567 626 procedure TProgress.Increment; 568 627 begin
Note:
See TracChangeset
for help on using the changeset viewer.