- Timestamp:
- Apr 19, 2018, 4:05:54 PM (7 years ago)
- Location:
- Common
- Files:
-
- 6 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Languages/UJobProgressView.cs.po
r510 r512 24 24 msgstr "Dokončené" 25 25 26 #: ujobprogressview.soperations 27 msgid "Operations:" 28 msgstr "" 29 26 30 #: ujobprogressview.spleasewait 27 31 msgid "Please wait..." -
Common/Languages/UJobProgressView.po
r510 r512 14 14 msgstr "" 15 15 16 #: ujobprogressview.soperations 17 msgid "Operations:" 18 msgstr "" 19 16 20 #: ujobprogressview.spleasewait 17 21 msgid "Please wait..." -
Common/UJobProgressView.lfm
r510 r512 1 1 object FormJobProgressView: TFormJobProgressView 2 2 Left = 467 3 Height = 2463 Height = 345 4 4 Top = 252 5 Width = 3285 Width = 539 6 6 BorderIcons = [biSystemMenu] 7 ClientHeight = 2468 ClientWidth = 3287 ClientHeight = 345 8 ClientWidth = 539 9 9 DesignTimePPI = 120 10 Font.Height = -1111 Font.Name = 'MS Sans Serif'12 10 OnClose = FormClose 13 11 OnCloseQuery = FormCloseQuery 14 12 OnCreate = FormCreate 15 13 OnDestroy = FormDestroy 14 OnHide = FormHide 15 OnShow = FormShow 16 16 Position = poScreenCenter 17 17 LCLVersion = '1.8.2.0' 18 18 object PanelOperationsTitle: TPanel 19 19 Left = 0 20 Height = 2420 Height = 32 21 21 Top = 0 22 Width = 32823 Align = alTop 24 BevelOuter = bvNone 25 ClientHeight = 2426 ClientWidth = 32822 Width = 539 23 Align = alTop 24 BevelOuter = bvNone 25 ClientHeight = 32 26 ClientWidth = 539 27 27 FullRepaint = False 28 28 TabOrder = 0 29 29 object LabelOperation: TLabel 30 30 Left = 8 31 Height = 1331 Height = 20 32 32 Top = 8 33 Width = 6633 Width = 76 34 34 Caption = 'Operations:' 35 Font.Height = -1136 Font.Name = 'MS Sans Serif'37 Font.Style = [fsBold]38 35 ParentColor = False 39 36 ParentFont = False … … 42 39 object PanelLog: TPanel 43 40 Left = 0 44 Height = 1 2245 Top = 12446 Width = 32841 Height = 133 42 Top = 212 43 Width = 539 47 44 Align = alClient 48 45 BevelOuter = bvSpace 49 ClientHeight = 1 2250 ClientWidth = 32846 ClientHeight = 133 47 ClientWidth = 539 51 48 TabOrder = 1 52 49 object MemoLog: TMemo 53 50 Left = 8 54 Height = 1 0651 Height = 117 55 52 Top = 8 56 Width = 31253 Width = 523 57 54 Anchors = [akTop, akLeft, akRight, akBottom] 58 55 ReadOnly = True … … 63 60 object PanelProgress: TPanel 64 61 Left = 0 65 Height = 3866 Top = 5067 Width = 32868 Align = alTop 69 BevelOuter = bvNone 70 ClientHeight = 3871 ClientWidth = 32862 Height = 54 63 Top = 106 64 Width = 539 65 Align = alTop 66 BevelOuter = bvNone 67 ClientHeight = 54 68 ClientWidth = 539 72 69 TabOrder = 2 73 70 object ProgressBarPart: TProgressBar 74 Left = 875 Height = 1776 Top = 1677 Width = 31271 Left = 10 72 Height = 24 73 Top = 24 74 Width = 523 78 75 Anchors = [akTop, akLeft, akRight] 79 76 TabOrder = 0 … … 81 78 object LabelEstimatedTimePart: TLabel 82 79 Left = 8 83 Height = 1380 Height = 20 84 81 Top = -2 85 Width = 7182 Width = 103 86 83 Caption = 'Estimated time:' 87 84 ParentColor = False … … 90 87 object PanelOperations: TPanel 91 88 Left = 0 92 Height = 2693 Top = 2494 Width = 32895 Align = alTop 96 BevelOuter = bvNone 97 ClientHeight = 2698 ClientWidth = 32889 Height = 42 90 Top = 64 91 Width = 539 92 Align = alTop 93 BevelOuter = bvNone 94 ClientHeight = 42 95 ClientWidth = 539 99 96 FullRepaint = False 100 97 TabOrder = 3 101 98 object ListViewJobs: TListView 102 99 Left = 8 103 Height = 16100 Height = 32 104 101 Top = 5 105 Width = 312102 Width = 523 106 103 Anchors = [akTop, akLeft, akRight, akBottom] 107 104 AutoWidthLastColumn = True … … 110 107 Columns = < 111 108 item 112 Width = 312109 Width = 523 113 110 end> 114 111 OwnerData = True … … 123 120 object PanelProgressTotal: TPanel 124 121 Left = 0 125 Height = 36126 Top = 88127 Width = 328128 Align = alTop 129 BevelOuter = bvNone 130 ClientHeight = 36131 ClientWidth = 328122 Height = 52 123 Top = 160 124 Width = 539 125 Align = alTop 126 BevelOuter = bvNone 127 ClientHeight = 52 128 ClientWidth = 539 132 129 TabOrder = 4 133 130 object LabelEstimatedTimeTotal: TLabel 134 131 Left = 8 135 Height = 13132 Height = 20 136 133 Top = 0 137 Width = 97134 Width = 141 138 135 Caption = 'Total estimated time:' 139 136 ParentColor = False … … 141 138 object ProgressBarTotal: TProgressBar 142 139 Left = 8 143 Height = 16144 Top = 16145 Width = 312140 Height = 24 141 Top = 24 142 Width = 523 146 143 Anchors = [akTop, akLeft, akRight] 147 144 TabOrder = 0 145 end 146 end 147 object PanelText: TPanel 148 Left = 0 149 Height = 32 150 Top = 32 151 Width = 539 152 Align = alTop 153 BevelOuter = bvNone 154 ClientHeight = 32 155 ClientWidth = 539 156 TabOrder = 5 157 object LabelText: TLabel 158 Left = 8 159 Height = 24 160 Top = 8 161 Width = 525 162 Anchors = [akTop, akLeft, akRight] 163 AutoSize = False 164 ParentColor = False 148 165 end 149 166 end -
Common/UJobProgressView.pas
r510 r512 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; … … 120 131 procedure SetTerminate(const AValue: Boolean); 121 132 procedure UpdateProgress; 122 procedure ReloadJobList;123 procedure StartJobs;124 procedure UpdateHeight;125 133 procedure JobProgressChange(Sender: TObject); 126 134 public 127 135 Form: TFormJobProgressView; 128 Jobs: T ObjectList; // TListObject<TJob>136 Jobs: TJobs; 129 137 CurrentJob: TJob; 130 138 CurrentJobIndex: Integer; … … 134 142 procedure AddJob(Title: string; Method: TJobProgressViewMethod; 135 143 NoThreaded: Boolean = False; WaitFor: Boolean = False); 136 procedure Start (AAutoClose: Boolean = True);144 procedure Start; 137 145 procedure Stop; 138 146 procedure TermSleep(Delay: Integer); … … 166 174 STotalEstimatedTime = 'Total estimated time: %s'; 167 175 SFinished = 'Finished'; 176 SOperations = 'Operations:'; 168 177 169 178 procedure Register; … … 207 216 end; 208 217 209 procedure TJobProgressView.Start(AAutoClose: Boolean = True); 210 begin 211 AutoClose := AAutoClose; 212 StartJobs; 213 end; 214 215 procedure TJobProgressView.StartJobs; 218 procedure TJobProgressView.Start; 216 219 var 217 220 I: Integer; … … 228 231 Form.MemoLog.Clear; 229 232 233 Form.PanelText.Visible := False; 230 234 Form.LabelEstimatedTimePart.Visible := False; 231 235 Form.LabelEstimatedTimeTotal.Visible := False; … … 257 261 Form.ProgressBarPart.Visible := False; 258 262 //Show; 259 ReloadJobList;263 Form.ReloadJobList; 260 264 Application.ProcessMessages; 261 265 if NoThreaded then begin … … 295 299 //if Visible then Hide; 296 300 Form.MemoLog.Lines.Assign(Log); 297 if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin301 if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin 298 302 Form.Hide; 299 303 end; 300 Clear;304 //Clear; 301 305 Form.Caption := SFinished; 302 306 //LabelEstimatedTimePart.Visible := False; 303 307 Finished := True; 304 308 CurrentJobIndex := -1; 305 ReloadJobList;306 end; 307 end; 308 309 procedure T JobProgressView.UpdateHeight;309 Form.ReloadJobList; 310 end; 311 end; 312 313 procedure TFormJobProgressView.UpdateHeight; 310 314 var 311 315 H: Integer; … … 315 319 PanelProgressTotalVisible: Boolean; 316 320 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; 346 end; 321 MemoLogHeight: Integer = 200; 322 I: Integer; 323 ItemRect: TRect; 324 MaxH: Integer; 325 begin 326 H := PanelOperationsTitle.Height; 327 PanelOperationsVisible := JobProgressView.Jobs.Count > 0; 328 if PanelOperationsVisible <> PanelOperations.Visible then 329 PanelOperations.Visible := PanelOperationsVisible; 330 if ListViewJobs.Items.Count > 0 then begin 331 Maxh := 0; 332 for I := 0 to ListViewJobs.Items.Count - 1 do 333 begin 334 ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds); 335 Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top)); 336 end; 337 PanelOperationsHeight := Scale96ToScreen(12) + Maxh; 338 end else PanelOperationsHeight := Scale96ToScreen(8); 339 if PanelOperationsHeight <> PanelOperations.Height then 340 PanelOperations.Height := PanelOperationsHeight; 341 if PanelOperationsVisible then 342 H := H + PanelOperations.Height; 343 344 PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished; 345 if PanelProgressVisible <> PanelProgress.Visible then 346 PanelProgress.Visible := PanelProgressVisible; 347 if PanelProgressVisible then 348 H := H + PanelProgress.Height; 349 PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished; 350 if PanelProgressTotalVisible <> PanelProgressTotal.Visible then 351 PanelProgressTotal.Visible := PanelProgressTotalVisible; 352 if PanelProgressTotalVisible then 353 H := H + PanelProgressTotal.Height; 354 Constraints.MinHeight := H; 355 PanelLogVisible := MemoLog.Lines.Count > 0; 356 if PanelLogVisible <> PanelLog.Visible then 357 PanelLog.Visible := PanelLogVisible; 358 if PanelLogVisible then 359 H := H + Scale96ToScreen(MemoLogHeight); 360 if PanelText.Visible then 361 H := H + PanelText.Height; 362 if Height <> H then Height := H; 347 363 end; 348 364 … … 373 389 if not JobProgressView.OwnerDraw then Show; 374 390 end; 391 if Assigned(JobProgressView.CurrentJob) then begin 392 LabelText.Caption := JobProgressView.CurrentJob.Progress.Text; 393 if LabelText.Caption <> '' then begin 394 PanelText.Visible := True; 395 UpdateHeight; 396 end; 397 end; 375 398 end; 376 399 … … 394 417 var CloseAction: TCloseAction); 395 418 begin 396 ListViewJobs.Clear;397 419 end; 398 420 … … 407 429 408 430 end; 431 end; 432 433 procedure TFormJobProgressView.ReloadJobList; 434 begin 435 // Workaround for not showing first line 436 //Form.ListViewJobs.Items.Count := Jobs.Count + 1; 437 //Form.ListViewJobs.Refresh; 438 439 if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then 440 ListViewJobs.Items.Count := JobProgressView.Jobs.Count; 441 ListViewJobs.Refresh; 442 Application.ProcessMessages; 443 UpdateHeight; 444 end; 445 446 procedure TFormJobProgressView.FormShow(Sender: TObject); 447 begin 448 ReloadJobList; 449 end; 450 451 procedure TFormJobProgressView.FormHide(Sender: TObject); 452 begin 453 JobProgressView.Jobs.Clear; 454 ReloadJobList; 409 455 end; 410 456 … … 489 535 end; 490 536 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 537 constructor TJobProgressView.Create(TheOwner: TComponent); 505 538 begin … … 509 542 Form.JobProgressView := Self; 510 543 end; 511 Jobs := T ObjectList.Create;544 Jobs := TJobs.Create; 512 545 Log := TStringList.Create; 513 546 //PanelOperationsTitle.Height := 80; … … 535 568 if FMax < 1 then FMax := 1; 536 569 if FValue >= FMax then FValue := FMax; 570 finally 571 FLock.Release; 572 end; 573 end; 574 575 procedure TProgress.SetText(AValue: string); 576 begin 577 try 578 FLock.Acquire; 579 if FText = AValue then Exit; 580 FText := AValue; 537 581 finally 538 582 FLock.Release;
Note:
See TracChangeset
for help on using the changeset viewer.