1 | unit fTemplateImport;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | Gauges, StdCtrls, ComCtrls, fBase508Form, VA508AccessibilityManager;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmTemplateImport = class(TfrmBase508Form)
|
---|
11 | animImport: TAnimate;
|
---|
12 | btnCancel: TButton;
|
---|
13 | lblImporting: TStaticText;
|
---|
14 | gaugeImport: TGauge;
|
---|
15 | procedure btnCancelClick(Sender: TObject);
|
---|
16 | private
|
---|
17 | { Private declarations }
|
---|
18 | public
|
---|
19 | { Public declarations }
|
---|
20 | end;
|
---|
21 |
|
---|
22 | procedure StartImportMessage(AFileName: string; MaxCount: integer);
|
---|
23 | function UpdateImportMessage(CurrentCount: integer): boolean;
|
---|
24 | procedure StopImportMessage;
|
---|
25 |
|
---|
26 | implementation
|
---|
27 |
|
---|
28 | {$R *.DFM}
|
---|
29 |
|
---|
30 | uses
|
---|
31 | ORFn;
|
---|
32 |
|
---|
33 | var
|
---|
34 | frmTemplateImport: TfrmTemplateImport = nil;
|
---|
35 |
|
---|
36 | procedure StartImportMessage(AFileName: string; MaxCount: integer);
|
---|
37 | begin
|
---|
38 | if not assigned(frmTemplateImport) then
|
---|
39 | begin
|
---|
40 | frmTemplateImport := TfrmTemplateImport.Create(Application);
|
---|
41 | ResizeAnchoredFormToFont(frmTemplateImport);
|
---|
42 | with frmTemplateImport do
|
---|
43 | begin
|
---|
44 | lblImporting.Caption := lblImporting.Caption + AFileName;
|
---|
45 | lblImporting.Hint := lblImporting.Caption;
|
---|
46 | gaugeImport.MaxValue := MaxCount;
|
---|
47 | Show;
|
---|
48 | Application.ProcessMessages;
|
---|
49 | end;
|
---|
50 | end;
|
---|
51 | end;
|
---|
52 |
|
---|
53 | function UpdateImportMessage(CurrentCount: integer): boolean;
|
---|
54 | begin
|
---|
55 | if assigned(frmTemplateImport) then
|
---|
56 | begin
|
---|
57 | Result := (not frmTemplateImport.btnCancel.Enabled);
|
---|
58 | if not Result then
|
---|
59 | begin
|
---|
60 | frmTemplateImport.gaugeImport.Progress := CurrentCount;
|
---|
61 | Application.ProcessMessages;
|
---|
62 | end;
|
---|
63 | end
|
---|
64 | else
|
---|
65 | Result := TRUE;
|
---|
66 | end;
|
---|
67 |
|
---|
68 | procedure StopImportMessage;
|
---|
69 | begin
|
---|
70 | if assigned(frmTemplateImport) then
|
---|
71 | FreeAndNil(frmTemplateImport);
|
---|
72 | end;
|
---|
73 |
|
---|
74 |
|
---|
75 | procedure TfrmTemplateImport.btnCancelClick(Sender: TObject);
|
---|
76 | begin
|
---|
77 | lblImporting.Caption := 'Canceling...';
|
---|
78 | btnCancel.Enabled := FALSE;
|
---|
79 | Application.ProcessMessages;
|
---|
80 | end;
|
---|
81 |
|
---|
82 | end.
|
---|