Changeset 513
- Timestamp:
- Apr 19, 2018, 5:07:40 PM (7 years ago)
- Location:
- Common
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Demo/JobProgressView/JobProgressViewDemo.lpi
r512 r513 80 80 <Filename Value="UFormMain.pas"/> 81 81 <IsPartOfProject Value="True"/> 82 <ComponentName Value="Form 1"/>82 <ComponentName Value="FormMain"/> 83 83 <ResourceBaseClass Value="Form"/> 84 84 </Unit1> -
Common/Demo/JobProgressView/JobProgressViewDemo.lpr
r512 r513 16 16 RequireDerivedFormResource:=True; 17 17 Application.Initialize; 18 Application.CreateForm(TForm 1, Form1);18 Application.CreateForm(TFormMain, FormMain); 19 19 Application.Run; 20 20 end. -
Common/Demo/JobProgressView/UFormMain.lfm
r512 r513 1 object Form 1: TForm12 Left = 5 151 object FormMain: TFormMain 2 Left = 501 3 3 Height = 480 4 Top = 2 524 Top = 296 5 5 Width = 743 6 6 Caption = 'JobProgressView demo' … … 89 89 ShowDelay = 0 90 90 AutoClose = False 91 left = 48 892 top = 7291 left = 480 92 top = 120 93 93 end 94 94 end -
Common/Demo/JobProgressView/UFormMain.pas
r512 r513 11 11 type 12 12 13 { TForm 1}13 { TFormMain } 14 14 15 TForm 1= class(TForm)15 TFormMain = class(TForm) 16 16 ButtonTest: TButton; 17 17 CheckBoxAutoClose: TCheckBox; … … 32 32 33 33 var 34 Form 1: TForm1;34 FormMain: TFormMain; 35 35 36 36 implementation … … 38 38 {$R *.lfm} 39 39 40 { TForm 1}40 { TFormMain } 41 41 42 procedure TForm 1.ButtonTestClick(Sender: TObject);42 procedure TFormMain.ButtonTestClick(Sender: TObject); 43 43 var 44 44 I: Integer; 45 45 begin 46 ButtonTest.Enabled := False; 46 47 with JobProgressView1 do begin 47 48 AutoClose := CheckBoxAutoClose.Checked; … … 52 53 Start; 53 54 end; 55 ButtonTest.Enabled := True; 54 56 end; 55 57 56 procedure TForm 1.JobMethod(Job: TJob);58 procedure TFormMain.JobMethod(Job: TJob); 57 59 var 58 60 Count: Integer; -
Common/UJobProgressView.pas
r512 r513 129 129 TotalStartTime: TDateTime; 130 130 Log: TStringList; 131 FForm: TFormJobProgressView; 131 132 procedure SetTerminate(const AValue: Boolean); 132 133 procedure UpdateProgress; 133 134 procedure JobProgressChange(Sender: TObject); 134 135 public 135 Form: TFormJobProgressView;136 136 Jobs: TJobs; 137 137 CurrentJob: TJob; … … 140 140 destructor Destroy; override; 141 141 procedure Clear; 142 procedureAddJob(Title: string; Method: TJobProgressViewMethod;143 NoThreaded: Boolean = False; WaitFor: Boolean = False) ;142 function AddJob(Title: string; Method: TJobProgressViewMethod; 143 NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob; 144 144 procedure Start; 145 145 procedure Stop; 146 146 procedure TermSleep(Delay: Integer); 147 property Form: TFormJobProgressView read FForm; 147 148 property Terminate: Boolean read FTerminate write SetTerminate; 148 149 published … … 181 182 end; 182 183 184 { TJobThread } 185 183 186 procedure TJobThread.Execute; 184 187 begin … … 198 201 end; 199 202 200 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod; 201 NoThreaded: Boolean = False; WaitFor: Boolean = False); 203 { TFormJobProgressView } 204 205 procedure TFormJobProgressView.UpdateHeight; 202 206 var 203 NewJob: TJob; 204 begin 205 NewJob := TJob.Create; 206 NewJob.ProgressView := Self; 207 NewJob.Title := Title; 208 NewJob.Method := Method; 209 NewJob.NoThreaded := NoThreaded; 210 NewJob.WaitFor := WaitFor; 211 NewJob.Progress.Max := 100; 212 NewJob.Progress.Reset; 213 NewJob.Progress.OnChange := JobProgressChange; 214 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); 215 369 //ReloadJobList; 216 370 end; … … 302 456 Form.Hide; 303 457 end; 304 //Clear;458 if not Form.Visible then Clear; 305 459 Form.Caption := SFinished; 306 460 //LabelEstimatedTimePart.Visible := False; … … 311 465 end; 312 466 313 procedure TFormJobProgressView.UpdateHeight;314 var315 H: Integer;316 PanelOperationsVisible: Boolean;317 PanelOperationsHeight: Integer;318 PanelProgressVisible: Boolean;319 PanelProgressTotalVisible: Boolean;320 PanelLogVisible: Boolean;321 MemoLogHeight: Integer = 200;322 I: Integer;323 ItemRect: TRect;324 MaxH: Integer;325 begin326 H := PanelOperationsTitle.Height;327 PanelOperationsVisible := JobProgressView.Jobs.Count > 0;328 if PanelOperationsVisible <> PanelOperations.Visible then329 PanelOperations.Visible := PanelOperationsVisible;330 if ListViewJobs.Items.Count > 0 then begin331 Maxh := 0;332 for I := 0 to ListViewJobs.Items.Count - 1 do333 begin334 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 then340 PanelOperations.Height := PanelOperationsHeight;341 if PanelOperationsVisible then342 H := H + PanelOperations.Height;343 344 PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;345 if PanelProgressVisible <> PanelProgress.Visible then346 PanelProgress.Visible := PanelProgressVisible;347 if PanelProgressVisible then348 H := H + PanelProgress.Height;349 PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;350 if PanelProgressTotalVisible <> PanelProgressTotal.Visible then351 PanelProgressTotal.Visible := PanelProgressTotalVisible;352 if PanelProgressTotalVisible then353 H := H + PanelProgressTotal.Height;354 Constraints.MinHeight := H;355 PanelLogVisible := MemoLog.Lines.Count > 0;356 if PanelLogVisible <> PanelLog.Visible then357 PanelLog.Visible := PanelLogVisible;358 if PanelLogVisible then359 H := H + Scale96ToScreen(MemoLogHeight);360 if PanelText.Visible then361 H := H + PanelText.Height;362 if Height <> H then Height := H;363 end;364 365 467 procedure TJobProgressView.JobProgressChange(Sender: TObject); 366 468 begin 367 469 if Assigned(FOnOwnerDraw) then 368 470 FOnOwnerDraw(Self); 369 end;370 371 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);372 var373 ProgressBarPartVisible: Boolean;374 ProgressBarTotalVisible: Boolean;375 begin376 JobProgressView.UpdateProgress;377 if Visible and (not ProgressBarPart.Visible) and378 Assigned(JobProgressView.CurrentJob) and379 (JobProgressView.CurrentJob.Progress.Value > 0) then begin380 ProgressBarPartVisible := True;381 if ProgressBarPartVisible <> ProgressBarPart.Visible then382 ProgressBarPart.Visible := ProgressBarPartVisible;383 ProgressBarTotalVisible := True;384 if ProgressBarTotalVisible <> ProgressBarTotal.Visible then385 ProgressBarTotal.Visible := ProgressBarTotalVisible;386 end;387 if not Visible then begin388 TimerUpdate.Interval := UpdateInterval;389 if not JobProgressView.OwnerDraw then Show;390 end;391 if Assigned(JobProgressView.CurrentJob) then begin392 LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;393 if LabelText.Caption <> '' then begin394 PanelText.Visible := True;395 UpdateHeight;396 end;397 end;398 end;399 400 procedure TFormJobProgressView.FormDestroy(Sender:TObject);401 begin402 end;403 404 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);405 begin406 if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then407 with TJob(JobProgressView.Jobs[Item.Index]) do begin408 Item.Caption := Title;409 if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1410 else if Finished then Item.ImageIndex := 0411 else Item.ImageIndex := 2;412 Item.Data := JobProgressView.Jobs[Item.Index];413 end;414 end;415 416 procedure TFormJobProgressView.FormClose(Sender: TObject;417 var CloseAction: TCloseAction);418 begin419 end;420 421 procedure TFormJobProgressView.FormCreate(Sender: TObject);422 begin423 Caption := SPleaseWait;424 try425 //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +426 // DirectorySeparator + 'horse.avi';427 //Animate1.Active := True;428 except429 430 end;431 end;432 433 procedure TFormJobProgressView.ReloadJobList;434 begin435 // Workaround for not showing first line436 //Form.ListViewJobs.Items.Count := Jobs.Count + 1;437 //Form.ListViewJobs.Refresh;438 439 if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then440 ListViewJobs.Items.Count := JobProgressView.Jobs.Count;441 ListViewJobs.Refresh;442 Application.ProcessMessages;443 UpdateHeight;444 end;445 446 procedure TFormJobProgressView.FormShow(Sender: TObject);447 begin448 ReloadJobList;449 end;450 451 procedure TFormJobProgressView.FormHide(Sender: TObject);452 begin453 JobProgressView.Jobs.Clear;454 ReloadJobList;455 471 end; 456 472 … … 471 487 Sleep(Quantum); 472 488 end; 473 end;474 475 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);476 begin477 CanClose := JobProgressView.Finished;478 JobProgressView.Terminate := True;479 Caption := SPleaseWait + STerminate;480 489 end; 481 490 … … 539 548 inherited; 540 549 if not (csDesigning in ComponentState) then begin 541 F orm := TFormJobProgressView.Create(Self);542 F orm.JobProgressView := Self;550 FForm := TFormJobProgressView.Create(Self); 551 FForm.JobProgressView := Self; 543 552 end; 544 553 Jobs := TJobs.Create; 545 554 Log := TStringList.Create; 546 555 //PanelOperationsTitle.Height := 80; 547 ShowDelay := 0; //1000; // ms 556 AutoClose := True; 557 ShowDelay := 0; 548 558 end; 549 559 … … 551 561 begin 552 562 Jobs.Clear; 563 Log.Clear; 553 564 //ReloadJobList; 554 565 end; … … 560 571 inherited; 561 572 end; 573 574 { TProgress } 562 575 563 576 procedure TProgress.SetMax(const AValue: Integer); … … 606 619 end; 607 620 608 { TProgress }609 610 621 procedure TProgress.Increment; 611 622 begin
Note:
See TracChangeset
for help on using the changeset viewer.