1
2 {*****************************************}
3 { }
4 { FastReport v2.3 }
5 { Progress dialog }
6 { }
7 { Copyright (c) 1998-99 by Tzyganenko A. }
8 { }
9 {*****************************************}
10
11 unit LR_progr;
12
13 interface
14
15 {$I LR_Vers.inc}
16
17 uses
18 Classes, SysUtils, LResources, LMessages,
19 Forms, Controls, Graphics, Dialogs,
20 Buttons, StdCtrls,LCLIntf,
21
22 LCLProc,
23
24 LR_Const, LR_Class, ExtCtrls;
25
26 const
27 CM_BeforeModal = WM_USER + 1;
28
29 type
30
31 { TfrProgressForm }
32
33 TfrProgressForm = class(TForm)
34 Button1: TButton;
35 Label1: TLabel;
36 Timer1: TTimer;
37 procedure Button1Click(Sender: TObject);
38 procedure FormCreate(Sender: TObject);
39 procedure Timer1Timer(Sender: TObject);
40 private
41 { Private declarations }
42 fDoc: TfrReport;
43 fOnBeforeModal: TNotifyEvent;
44 procedure DoBeforeModal({%H-}Data: ptrint);
45 public
46 { Public declarations }
47 FirstCaption: String;
Show_Modalnull48 function Show_Modal(Doc: TfrReport): Word;
49 procedure ModalDone(AModalResult: TModalResult);
50
51 property OnBeforeModal: TNotifyEvent read FOnBeforeModal write FOnBeforeModal;
52 end;
53
54 var
55 frProgressForm: TfrProgressForm;
56
57 implementation
58
59 {$R *.lfm}
60
TfrProgressForm.Show_Modalnull61 function TfrProgressForm.Show_Modal(Doc: TfrReport): Word;
62 begin
63 FDoc := Doc;
64 Application.QueueAsyncCall(@DoBeforeModal, 0);
65 //PostMessage(Handle, CM_BeforeModal, 0, 0);
66 Visible:=False;
67 Enabled:=True;
68 ModalResult:=mrNone;
69 InitializeWnd;
70 Result:=ShowModal;
71 end;
72
73 procedure TfrProgressForm.ModalDone(AModalResult: TModalResult);
74 begin
75 ModalResult := AModalResult;
76 Timer1.Enabled:=true;
77 end;
78
79 procedure TfrProgressForm.Button1Click(Sender: TObject);
80 begin
81 fDoc.Terminated := True;
82 ModalResult := mrCancel;
83 end;
84
85 procedure TfrProgressForm.DoBeforeModal(Data: Ptrint);
86 begin
87 if Assigned(fOnBeforeModal) then
88 fOnBeforeModal(Self);
89 end;
90
91 procedure TfrProgressForm.FormCreate(Sender: TObject);
92 begin
93 Button1.Caption:=sCancel;
94 end;
95
96 procedure TfrProgressForm.Timer1Timer(Sender: TObject);
97 begin
98 Timer1.Enabled:=false;
99 end;
100
101 end.
102
103