Changeset 75 for trunk/Packages/Common/JobProgressView.pas
- Timestamp:
- Jun 4, 2024, 12:22:49 AM (5 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/JobProgressView.pas
r74 r75 1 unit UJobProgressView; 2 3 {$MODE Delphi} 1 unit JobProgressView; 4 2 5 3 interface … … 7 5 uses 8 6 SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs, 9 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Generics.Collections, Threading, Math, 10 8 DateUtils; 11 9 … … 13 11 EstimatedTimeShowTreshold = 4; 14 12 EstimatedTimeShowTresholdTotal = 1; 15 MemoLogHeight = 200;16 13 UpdateInterval = 100; // ms 17 14 … … 24 21 FLock: TCriticalSection; 25 22 FOnChange: TNotifyEvent; 23 FText: string; 26 24 FValue: Integer; 27 25 FMax: Integer; 28 26 procedure SetMax(const AValue: Integer); 27 procedure SetText(AValue: string); 29 28 procedure SetValue(const AValue: Integer); 30 29 public … … 35 34 property Value: Integer read FValue write SetValue; 36 35 property Max: Integer read FMax write SetMax; 36 property Text: string read FText write SetText; 37 37 property OnChange: TNotifyEvent read FOnChange write FOnChange; 38 38 end; … … 69 69 end; 70 70 71 TJobs = class(TObjectList<TJob>) 72 end; 73 71 74 TJobThread = class(TListedThread) 72 75 procedure Execute; override; … … 80 83 TFormJobProgressView = class(TForm) 81 84 ImageList1: TImageList; 85 LabelText: TLabel; 82 86 Label2: TLabel; 83 87 LabelOperation: TLabel; … … 86 90 ListViewJobs: TListView; 87 91 MemoLog: TMemo; 92 PanelText: TPanel; 88 93 PanelProgressTotal: TPanel; 89 94 PanelOperationsTitle: TPanel; … … 94 99 ProgressBarTotal: TProgressBar; 95 100 TimerUpdate: TTimer; 101 procedure FormHide(Sender: TObject); 102 procedure FormShow(Sender: TObject); 103 procedure ReloadJobList; 96 104 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 97 procedure FormDestroy(Sender: TObject);98 105 procedure ListViewJobsData(Sender: TObject; Item: TListItem); 99 106 procedure TimerUpdateTimer(Sender: TObject); 100 107 procedure FormCreate(Sender: TObject); 101 108 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 109 procedure UpdateHeight; 102 110 public 103 111 JobProgressView: TJobProgressView; … … 118 126 TotalStartTime: TDateTime; 119 127 Log: TStringList; 128 FForm: TFormJobProgressView; 120 129 procedure SetTerminate(const AValue: Boolean); 121 130 procedure UpdateProgress; 122 procedure ReloadJobList;123 procedure StartJobs;124 procedure UpdateHeight;125 131 procedure JobProgressChange(Sender: TObject); 126 132 public 127 Form: TFormJobProgressView; 128 Jobs: TObjectList; // TListObject<TJob> 133 Jobs: TJobs; 129 134 CurrentJob: TJob; 130 135 CurrentJobIndex: Integer; … … 132 137 destructor Destroy; override; 133 138 procedure Clear; 134 procedureAddJob(Title: string; Method: TJobProgressViewMethod;135 NoThreaded: Boolean = False; WaitFor: Boolean = False) ;136 procedure Start (AAutoClose: Boolean = True);139 function AddJob(Title: string; Method: TJobProgressViewMethod; 140 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 141 procedure Start; 137 142 procedure Stop; 138 143 procedure TermSleep(Delay: Integer); 144 property Form: TFormJobProgressView read FForm; 139 145 property Terminate: Boolean read FTerminate write SetTerminate; 140 146 published … … 148 154 end; 149 155 150 //var151 // FormJobProgressView: TFormJobProgressView;152 153 156 procedure Register; 154 157 155 158 resourcestring 156 159 SExecuted = 'Executed'; 160 157 161 158 162 implementation … … 172 176 end; 173 177 178 { TJobThread } 179 174 180 procedure TJobThread.Execute; 175 181 begin 176 182 try 177 183 try 178 //raise Exception.Create('Exception in job');179 184 ProgressView.CurrentJob.Method(Job); 180 185 except … … 189 194 end; 190 195 191 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 192 NoThreaded: Boolean = False; WaitFor: Boolean = False); 196 { TFormJobProgressView } 197 198 procedure TFormJobProgressView.UpdateHeight; 193 199 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); 200 H: Integer; 201 PanelOperationsVisible: Boolean; 202 PanelOperationsHeight: Integer; 203 PanelProgressVisible: Boolean; 204 PanelProgressTotalVisible: Boolean; 205 PanelLogVisible: Boolean; 206 MemoLogHeight: Integer = 200; 207 I: Integer; 208 ItemRect: TRect; 209 MaxH: Integer; 210 begin 211 H := PanelOperationsTitle.Height; 212 PanelOperationsVisible := JobProgressView.Jobs.Count > 0; 213 if PanelOperationsVisible <> PanelOperations.Visible then 214 PanelOperations.Visible := PanelOperationsVisible; 215 if ListViewJobs.Items.Count > 0 then begin 216 Maxh := 0; 217 for I := 0 to ListViewJobs.Items.Count - 1 do 218 begin 219 ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds); 220 Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top)); 221 end; 222 PanelOperationsHeight := Scale96ToScreen(12) + Maxh; 223 end else PanelOperationsHeight := Scale96ToScreen(8); 224 if PanelOperationsHeight <> PanelOperations.Height then 225 PanelOperations.Height := PanelOperationsHeight; 226 if PanelOperationsVisible then 227 H := H + PanelOperations.Height; 228 229 PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished; 230 if PanelProgressVisible <> PanelProgress.Visible then 231 PanelProgress.Visible := PanelProgressVisible; 232 if PanelProgressVisible then 233 H := H + PanelProgress.Height; 234 PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished; 235 if PanelProgressTotalVisible <> PanelProgressTotal.Visible then 236 PanelProgressTotal.Visible := PanelProgressTotalVisible; 237 if PanelProgressTotalVisible then 238 H := H + PanelProgressTotal.Height; 239 Constraints.MinHeight := H; 240 PanelLogVisible := MemoLog.Lines.Count > 0; 241 if PanelLogVisible <> PanelLog.Visible then 242 PanelLog.Visible := PanelLogVisible; 243 if PanelLogVisible then 244 H := H + Scale96ToScreen(MemoLogHeight); 245 if PanelText.Visible then 246 H := H + PanelText.Height; 247 if Height <> H then begin 248 Height := H; 249 Top := (Screen.Height - H) div 2; 250 end; 251 end; 252 253 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject); 254 var 255 ProgressBarPartVisible: Boolean; 256 ProgressBarTotalVisible: Boolean; 257 begin 258 JobProgressView.UpdateProgress; 259 if Visible and (not ProgressBarPart.Visible) and 260 Assigned(JobProgressView.CurrentJob) and 261 (JobProgressView.CurrentJob.Progress.Value > 0) then begin 262 ProgressBarPartVisible := True; 263 if ProgressBarPartVisible <> ProgressBarPart.Visible then 264 ProgressBarPart.Visible := ProgressBarPartVisible; 265 ProgressBarTotalVisible := True; 266 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then 267 ProgressBarTotal.Visible := ProgressBarTotalVisible; 268 end; 269 if not Visible then begin 270 TimerUpdate.Interval := UpdateInterval; 271 if not JobProgressView.OwnerDraw then Show; 272 end; 273 if Assigned(JobProgressView.CurrentJob) then begin 274 LabelText.Caption := JobProgressView.CurrentJob.Progress.Text; 275 if LabelText.Caption <> '' then begin 276 PanelText.Visible := True; 277 UpdateHeight; 278 end; 279 end; 280 end; 281 282 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem); 283 begin 284 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then 285 with JobProgressView.Jobs[Item.Index] do begin 286 Item.Caption := Title; 287 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1 288 else if Finished then Item.ImageIndex := 0 289 else Item.ImageIndex := 2; 290 Item.Data := JobProgressView.Jobs[Item.Index]; 291 end; 292 end; 293 294 procedure TFormJobProgressView.FormClose(Sender: TObject; 295 var CloseAction: TCloseAction); 296 begin 297 end; 298 299 procedure TFormJobProgressView.FormCreate(Sender: TObject); 300 begin 301 Caption := SPleaseWait; 302 try 303 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) + 304 // DirectorySeparator + 'horse.avi'; 305 //Animate1.Active := True; 306 except 307 308 end; 309 end; 310 311 procedure TFormJobProgressView.ReloadJobList; 312 begin 313 // Workaround for not showing first line 314 //Form.ListViewJobs.Items.Count := Jobs.Count + 1; 315 //Form.ListViewJobs.Refresh; 316 317 if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then 318 ListViewJobs.Items.Count := JobProgressView.Jobs.Count; 319 ListViewJobs.Refresh; 320 Application.ProcessMessages; 321 UpdateHeight; 322 end; 323 324 procedure TFormJobProgressView.FormShow(Sender: TObject); 325 begin 326 ReloadJobList; 327 end; 328 329 procedure TFormJobProgressView.FormHide(Sender: TObject); 330 begin 331 JobProgressView.Jobs.Clear; 332 ReloadJobList; 333 end; 334 335 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 336 begin 337 CanClose := JobProgressView.Finished; 338 JobProgressView.Terminate := True; 339 Caption := SPleaseWait + STerminate; 340 end; 341 342 343 { TJobProgressView } 344 345 function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 346 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 347 begin 348 Result := TJob.Create; 349 Result.ProgressView := Self; 350 Result.Title := Title; 351 Result.Method := Method; 352 Result.NoThreaded := NoThreaded; 353 Result.WaitFor := WaitFor; 354 Result.Progress.Max := 100; 355 Result.Progress.Reset; 356 Result.Progress.OnChange := JobProgressChange; 357 Jobs.Add(Result); 206 358 //ReloadJobList; 207 359 end; 208 360 209 procedure TJobProgressView.Start(AAutoClose: Boolean = True); 210 begin 211 AutoClose := AAutoClose; 212 StartJobs; 213 end; 214 215 procedure TJobProgressView.StartJobs; 361 procedure TJobProgressView.Start; 216 362 var 217 363 I: Integer; … … 228 374 Form.MemoLog.Clear; 229 375 376 Form.PanelText.Visible := False; 230 377 Form.LabelEstimatedTimePart.Visible := False; 231 378 Form.LabelEstimatedTimeTotal.Visible := False; … … 248 395 I := 0; 249 396 while I < Jobs.Count do 250 with TJob(Jobs[I])do begin397 with Jobs[I] do begin 251 398 CurrentJobIndex := I; 252 CurrentJob := TJob(Jobs[I]);399 CurrentJob := Jobs[I]; 253 400 JobProgressChange(Self); 254 401 StartTime := Now; … … 257 404 Form.ProgressBarPart.Visible := False; 258 405 //Show; 259 ReloadJobList;406 Form.ReloadJobList; 260 407 Application.ProcessMessages; 261 408 if NoThreaded then begin … … 263 410 Method(CurrentJob); 264 411 end else begin 412 Thread := TJobThread.Create(True); 265 413 try 266 Thread := TJobThread.Create(True);267 414 with Thread do begin 268 415 FreeOnTerminate := False; … … 295 442 //if Visible then Hide; 296 443 Form.MemoLog.Lines.Assign(Log); 297 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin444 if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin 298 445 Form.Hide; 299 446 end; 300 Clear;447 if not Form.Visible then Clear; 301 448 Form.Caption := SFinished; 302 449 //LabelEstimatedTimePart.Visible := False; 303 450 Finished := True; 304 451 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; 452 Form.ReloadJobList; 346 453 end; 347 454 end; … … 351 458 if Assigned(FOnOwnerDraw) then 352 459 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 460 end; 410 461 … … 427 478 end; 428 479 429 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);430 begin431 CanClose := JobProgressView.Finished;432 JobProgressView.Terminate := True;433 Caption := SPleaseWait + STerminate;434 end;435 436 480 procedure TJobProgressView.SetTerminate(const AValue: Boolean); 437 481 var … … 440 484 if AValue = FTerminate then Exit; 441 485 for I := 0 to Jobs.Count - 1 do 442 TJob(Jobs[I]).Terminate := AValue;486 Jobs[I].Terminate := AValue; 443 487 FTerminate := AValue; 444 488 end; … … 489 533 end; 490 534 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 535 constructor TJobProgressView.Create(TheOwner: TComponent); 505 536 begin 506 537 inherited; 507 538 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;539 FForm := TFormJobProgressView.Create(Self); 540 FForm.JobProgressView := Self; 541 end; 542 Jobs := TJobs.Create; 512 543 Log := TStringList.Create; 513 544 //PanelOperationsTitle.Height := 80; 514 ShowDelay := 0; //1000; // ms 545 AutoClose := True; 546 ShowDelay := 0; 515 547 end; 516 548 … … 518 550 begin 519 551 Jobs.Clear; 552 Log.Clear; 520 553 //ReloadJobList; 521 554 end; … … 527 560 inherited; 528 561 end; 562 563 { TProgress } 529 564 530 565 procedure TProgress.SetMax(const AValue: Integer); … … 535 570 if FMax < 1 then FMax := 1; 536 571 if FValue >= FMax then FValue := FMax; 572 finally 573 FLock.Release; 574 end; 575 end; 576 577 procedure TProgress.SetText(AValue: string); 578 begin 579 try 580 FLock.Acquire; 581 if FText = AValue then Exit; 582 FText := AValue; 537 583 finally 538 584 FLock.Release; … … 562 608 end; 563 609 564 { TProgress }565 566 610 procedure TProgress.Increment; 567 611 begin 568 try569 FLock.Acquire;612 FLock.Acquire; 613 try 570 614 Value := Value + 1; 571 615 finally … … 576 620 procedure TProgress.Reset; 577 621 begin 578 try579 FLock.Acquire;622 FLock.Acquire; 623 try 580 624 FValue := 0; 581 625 finally … … 593 637 begin 594 638 FLock.Free; 595 inherited Destroy;639 inherited; 596 640 end; 597 641 … … 624 668 destructor TJob.Destroy; 625 669 begin 626 Progress.Free;670 FreeAndNil(Progress); 627 671 inherited; 628 672 end;
Note:
See TracChangeset
for help on using the changeset viewer.