source: cprs/branches/tmg-cprs/CPRS-Chart/fTimeout.pas@ 1547

Last change on this file since 1547 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 1.8 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/20/2007
2unit fTimeout;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, ExtCtrls, StdCtrls, ORFn, DKLang;
9
10type
11 TfrmTimeout = class(TfrmAutoSz)
12 Label1: TStaticText;
13 Label2: TStaticText;
14 cmdContinue: TButton;
15 lblCount: TStaticText;
16 timCountDown: TTimer;
17 DKLanguageController2: TDKLanguageController;
18 procedure FormCreate(Sender: TObject);
19 procedure cmdContinueClick(Sender: TObject);
20 procedure timCountDownTimer(Sender: TObject);
21 private
22 { Private declarations }
23 FContinue: Boolean;
24 FCount: Integer;
25 end;
26
27function AllowTimeout: Boolean;
28
29implementation
30
31{$R *.DFM}
32
33uses uCore;
34
35function AllowTimeout: Boolean;
36var
37 frmTimeout: TfrmTimeout;
38begin
39 frmTimeout := TfrmTimeout.Create(Application);
40 try
41 ResizeFormToFont(TForm(frmTimeout));
42 frmTimeout.ShowModal;
43 Result := not frmTimeout.FContinue;
44 finally
45 frmTimeout.Release;
46 end;
47end;
48
49procedure TfrmTimeout.FormCreate(Sender: TObject);
50begin
51 inherited;
52 MessageBeep(MB_ICONASTERISK);
53 FCount := User.CountDown;
54 lblCount.Caption := IntToStr(FCount);
55end;
56
57procedure TfrmTimeout.cmdContinueClick(Sender: TObject);
58begin
59 inherited;
60 FContinue := True;
61 Close;
62end;
63
64procedure TfrmTimeout.timCountDownTimer(Sender: TObject);
65begin
66 inherited;
67 if FCount = User.CountDown then
68 begin
69 MessageBeep(MB_ICONASTERISK);
70 timCountDown.Enabled := False;
71 timCountDown.Interval := 1000;
72 timCountDown.Enabled := True;
73 end;
74 Dec(FCount);
75 lblCount.Caption := IntToStr(FCount);
76 if FCount = 0 then
77 begin
78 timCountDown.Enabled := False;
79 Close;
80 end;
81end;
82
83end.
Note: See TracBrowser for help on using the repository browser.