1个窗体,1个unit
先说调用方法吧,刚才在csdn里也贴了这段代码..不过没写详细使用方法...汗..
1 CreateProgressDlg();
2 try
3 while () do begin
4 UpdateProgressDlg();
5 if ProgressCanceled then
6 break;
7 end;
8 finally
9 DestroyProgressDlg();
10 end;
View Code
1 //--------------------------------------------进度条窗体-------------------------------------
2
3 //------------------------------DFM文件---------------------------------
4
5 object Form_Process: TForm_Process
6 Left = 210
7 Top = 192
8 BorderIcons = [biSystemMenu]
9 BorderStyle = bsDialog
10 ClientHeight = 87
11 ClientWidth = 442
12 Color = clBtnFace
13 Font.Charset = GB2312_CHARSET
14 Font.Color = clWindowText
15 Font.Height = -12
16 Font.Name = '宋体'
17 Font.Style = []
18 FormStyle = fsStayOnTop
19 OldCreateOrder = True
20 Position = poScreenCenter
21 OnClose = FormClose
22 OnCreate = FormCreate
23 PixelsPerInch = 96
24 TextHeight = 12
25 object Bevel: TBevel
26 Left = 0
27 Top = 0
28 Width = 442
29 Height = 87
30 Shape = bsFrame
31 Style = bsRaised
32 end
33 object lblStatus: TLabel
34 Left = 8
35 Top = 56
36 Width = 339
37 Height = 13
38 AutoSize = False
39 end
40 object ProgressBar: TProgressBar
41 Left = 10
42 Top = 70
43 Width = 337
44 Height = 10
45 Min = 0
46 Max = 100
47 Position = 34
48 TabOrder = 0
49 end
50 object btnCancel: TButton
51 Left = 355
52 Top = 55
53 Width = 75
54 Height = 25
55 Cursor = crArrow
56 Cancel = True
57 Caption = '&Cancel'
58 ModalResult = 2
59 TabOrder = 1
60 OnClick = btnCancelClick
61 end
62 end
63
64 //---------------------------------------------PAS文件-------------------------------
65
66 unit UForm_Process;
67
68 interface
69
70 uses
71 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
72 ComCtrls, StdCtrls, ExtCtrls;
73
74 type
75 TForm_Process = class(TForm)
76 ProgressBar: TProgressBar;
77 btnCancel: TButton;
78 Bevel: TBevel;
79 lblStatus: TLabel;
80 procedure FormCreate(Sender: TObject);
81 procedure btnCancelClick(Sender: TObject);
82 procedure FormClose(Sender: TObject; var Action: TCloseAction);
83 private
84 { Private declarations }
85 public
86 { Public declarations }
87 Animate: TAnimate;
88 CancelPressed: Boolean;
89 end;
90
91 implementation
92
93 {$R *.DFM}
94
95 procedure TForm_Process.FormCreate(Sender: TObject);
96 begin
97 Animate := TAnimate.Create(Self);
98 with Animate do
99 begin
100 Left := 8;
101 Top := 4;
102 Width := 427;
103 Height := 45;
104 Parent := Self;
105 Active := False;
106 AutoSize := False;
107 CommonAVI := aviCopyFile;
108 StopFrame := 34;
109 ParentColor := True;
110 Transparent := True;
111 end;
112 CancelPressed := False;
113 DoubleBuffered := True;
114 end;
115
116 procedure TForm_Process.btnCancelClick(Sender: TObject);
117 begin
118 CancelPressed := True;
119 end;
120
121 procedure TForm_Process.FormClose(Sender: TObject;
122 var Action: TCloseAction);
123 begin
124 CancelPressed := True;
125 end;
126
127 end.
128
129
130
131 //-----------------------------------------进度条控制单元------------------------------
132
133 unit UControl_Process;
134 interface
135 uses
136 UForm_Process, Forms, SysUtils;
137
138 function CreateProgressDlg(strCaption, strMessage, strBtnCaption: string; MinValue, MaxValue, Progress: Longint): Boolean;
139 function DestroyProgressDlg: Boolean;
140 function UpdateProgressDlg(strMessage: string; Progress: Longint): Boolean;
141 function ProgressCanceled: Boolean;
142 implementation
143
144 var
145 Form_Process: TForm_Process;
146
147 function CreateProgressDlg(strCaption, strMessage, strBtnCaption: string; MinValue, MaxValue, Progress: Longint): Boolean;
148 begin
149 Result := False;
150
151 try
152 DestroyProgressDlg;
153 Form_Process := TForm_Process.Create(Application);
154 Application.ProcessMessages;
155 with Form_Process do
156 begin
157 Caption := strCaption;
158 lblStatus.Caption := strMessage;
159 btnCancel.Caption := strBtnCaption;
160 ProgressBar.Min := MinValue;
161 ProgressBar.Max := MaxValue;
162 ProgressBar.Position := Progress;
163 ProgressBar.Visible := not ((MinValue = 0) and (MaxValue = 0));
164 Animate.Active := True;
165 Show;
166 Application.ProcessMessages;
167 end;
168 Result := True;
169 except
170 try
171 Form_Process.Free;
172 finally
173 Form_Process := nil;
174 end;
175 end;
176 end;
177
178 function DestroyProgressDlg: Boolean;
179 begin
180 Result := False;
181
182 if Assigned(Form_Process) then
183 try
184 Form_Process.Animate.Active := False;
185 Form_Process.Free;
186 Form_Process := nil;
187 Application.ProcessMessages;
188 Result := True;
189 except
190 end;
191 end;
192
193 function UpdateProgressDlg(strMessage: string; Progress: Longint): Boolean;
194 begin
195 Result := False;
196
197 if Assigned(Form_Process) then
198 with Form_Process do
199 begin
200 lblStatus.Caption := strMessage + ' (' + IntToStr(Progress) + '/' + IntToStr(ProgressBar.Max) + ')';
201 ProgressBar.Position := Progress;
202 Update;
203
204 Application.ProcessMessages;
205
206 Result := True;
207 end;
208 end;
209
210 function ProgressCanceled: Boolean;
211 begin
212 Result := False;
213 if Assigned(Form_Process) then
214 Result := Form_Process.CancelPressed;
215 end;
216
217 end.