1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 A dialog for showing the progress of a boring calculation.
25 }
26 unit ProgressDlg;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons,
34 StdCtrls, ComCtrls, LazarusIDEStrConsts;
35
36 type
37
38 { TIDEProgressDialog }
39
40 TIDEProgressDialog = class(TForm)
41 AbortButton: TBitBtn;
42 DescriptionLabel: TLabel;
43 ProgressBar: TProgressBar;
44 procedure FormCreate(Sender: TObject);
45 procedure FormDestroy(Sender: TObject);
46 private
47 public
48 procedure ApplicationIdle(Sender: TObject; var {%H-}Done: Boolean);
49 end;
50
51 var
52 IDEProgressDialog: TIDEProgressDialog = nil;
53
ShowProgressnull54 function ShowProgress(const SomeText: string;
55 Step, MaxStep: integer): boolean;
56
57 implementation
58
59 {$R *.lfm}
60
61 type
62
63 { TProgressWait }
64
65 TProgressWait = class
66 public
67 StartTime: TDateTime;
68 StartTimeValid: boolean;
69 constructor Create;
70 procedure ApplicationIdle(Sender: TObject; var {%H-}Done: Boolean);
71 end;
72
73 { TProgressWait }
74
75 constructor TProgressWait.Create;
76 begin
77 Application.AddOnIdleHandler(@ApplicationIdle);
78 end;
79
80 procedure TProgressWait.ApplicationIdle(Sender: TObject; var Done: Boolean);
81 begin
82 StartTimeValid:=false;
83 end;
84
85 var
86 ProgressWait: TProgressWait = nil;
87
ShowProgressnull88 function ShowProgress(const SomeText: string; Step, MaxStep: integer): boolean;
89 const
90 Delay = 1.0/86400;
91
92 procedure InitDlg;
93 begin
94 IDEProgressDialog.DescriptionLabel.Caption:=SomeText;
95 if (Step>=0) and (MaxStep>Step) then begin
96 IDEProgressDialog.ProgressBar.Visible:=true;
97 IDEProgressDialog.ProgressBar.Max:=MaxStep;
98 IDEProgressDialog.ProgressBar.Position:=Step;
99 end else begin
100 IDEProgressDialog.ProgressBar.Visible:=false;
101 end;
102 end;
103
104 begin
105 if IDEProgressDialog<>nil then begin
106 // there is already a TIDEProgressDialog
107 InitDlg;
108 end else begin
109 // there is no TIDEProgressDialog yet
110 // create one after 1 second
111 if ProgressWait=nil then
112 ProgressWait:=TProgressWait.Create;
113 if ProgressWait.StartTimeValid then begin
114 if Now-ProgressWait.StartTime>Delay then begin
115 // one second waited
116 // => create a TIDEProgressDialog and show it modal
117 IDEProgressDialog:=TIDEProgressDialog.Create(Application);
118 InitDlg;
119 IDEProgressDialog.Show;
120 end;
121 end else begin
122 ProgressWait.StartTime:=Now;
123 end;
124 end;
125 Result:=true;
126 end;
127
128 { TIDEProgressDialog }
129
130 procedure TIDEProgressDialog.FormCreate(Sender: TObject);
131 begin
132 Caption:=lisPDProgress;
133 DescriptionLabel.Caption:='...';
134 AbortButton.Caption:=lisPDAbort;
135
136 Application.AddOnIdleHandler(@ApplicationIdle);
137 end;
138
139 procedure TIDEProgressDialog.FormDestroy(Sender: TObject);
140 begin
141 Application.RemoveOnIdleHandler(@ApplicationIdle);
142 end;
143
144 procedure TIDEProgressDialog.ApplicationIdle(Sender: TObject;
145 var Done: Boolean);
146 begin
147 // IDE got idle => progress dialog is not used anymore
148 if Screen.FormIndex(Self)>=0 then begin
149 // let the LCL close it on end of message loop
150 Close;
151 end else begin
152 // unused and invisible -> free it
153 FreeAndNil(IDEProgressDialog);
154 end;
155 end;
156
157 finalization
158 FreeAndNil(ProgressWait);
159
160 end.
161
162