Changeset 200 for trunk/Packages/Common/UJobProgressView.pas
- Timestamp:
- Aug 31, 2018, 3:38:01 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UJobProgressView.pas
r181 r200 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'; 177 SOperations = 'Operations:'; 168 178 169 179 procedure Register; … … 171 181 RegisterComponents('Common', [TJobProgressView]); 172 182 end; 183 184 { TJobThread } 173 185 174 186 procedure TJobThread.Execute; … … 189 201 end; 190 202 191 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 192 NoThreaded: Boolean = False; WaitFor: Boolean = False); 203 { TFormJobProgressView } 204 205 procedure TFormJobProgressView.UpdateHeight; 193 206 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); 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; … … 228 385 Form.MemoLog.Clear; 229 386 387 Form.PanelText.Visible := False; 230 388 Form.LabelEstimatedTimePart.Visible := False; 231 389 Form.LabelEstimatedTimeTotal.Visible := False; … … 257 415 Form.ProgressBarPart.Visible := False; 258 416 //Show; 259 ReloadJobList;417 Form.ReloadJobList; 260 418 Application.ProcessMessages; 261 419 if NoThreaded then begin … … 295 453 //if Visible then Hide; 296 454 Form.MemoLog.Lines.Assign(Log); 297 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin455 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; … … 351 469 if Assigned(FOnOwnerDraw) then 352 470 FOnOwnerDraw(Self); 353 end;354 355 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);356 var357 ProgressBarPartVisible: Boolean;358 ProgressBarTotalVisible: Boolean;359 begin360 JobProgressView.UpdateProgress;361 if Visible and (not ProgressBarPart.Visible) and362 Assigned(JobProgressView.CurrentJob) and363 (JobProgressView.CurrentJob.Progress.Value > 0) then begin364 ProgressBarPartVisible := True;365 if ProgressBarPartVisible <> ProgressBarPart.Visible then366 ProgressBarPart.Visible := ProgressBarPartVisible;367 ProgressBarTotalVisible := True;368 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then369 ProgressBarTotal.Visible := ProgressBarTotalVisible;370 end;371 if not Visible then begin372 TimerUpdate.Interval := UpdateInterval;373 if not JobProgressView.OwnerDraw then Show;374 end;375 end;376 377 procedure TFormJobProgressView.FormDestroy(Sender:TObject);378 begin379 end;380 381 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);382 begin383 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then384 with TJob(JobProgressView.Jobs[Item.Index]) do begin385 Item.Caption := Title;386 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1387 else if Finished then Item.ImageIndex := 0388 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 begin396 ListViewJobs.Clear;397 end;398 399 procedure TFormJobProgressView.FormCreate(Sender: TObject);400 begin401 Caption := SPleaseWait;402 try403 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +404 // DirectorySeparator + 'horse.avi';405 //Animate1.Active := True;406 except407 408 end;409 471 end; 410 472 … … 425 487 Sleep(Quantum); 426 488 end; 427 end;428 429 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);430 begin431 CanClose := JobProgressView.Finished;432 JobProgressView.Terminate := True;433 Caption := SPleaseWait + STerminate;434 489 end; 435 490 … … 489 544 end; 490 545 491 procedure TJobProgressView.ReloadJobList;492 begin493 UpdateHeight;494 // Workaround for not showing first line495 Form.ListViewJobs.Items.Count := Jobs.Count + 1;496 Form.ListViewJobs.Refresh;497 498 if Form.ListViewJobs.Items.Count <> Jobs.Count then499 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 F orm := TFormJobProgressView.Create(Self);509 F orm.JobProgressView := Self;510 end; 511 Jobs := T ObjectList.Create;550 FForm := TFormJobProgressView.Create(Self); 551 FForm.JobProgressView := Self; 552 end; 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 … … 518 561 begin 519 562 Jobs.Clear; 563 Log.Clear; 520 564 //ReloadJobList; 521 565 end; … … 527 571 inherited; 528 572 end; 573 574 { TProgress } 529 575 530 576 procedure TProgress.SetMax(const AValue: Integer); … … 535 581 if FMax < 1 then FMax := 1; 536 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; 537 594 finally 538 595 FLock.Release; … … 562 619 end; 563 620 564 { TProgress }565 566 621 procedure TProgress.Increment; 567 622 begin
Note:
See TracChangeset
for help on using the changeset viewer.