source: cprs/trunk/CPRS-Chart/fTimeout.pas@ 1613

Last change on this file since 1613 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 1.7 KB
RevLine 
[456]1unit fTimeout;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[830]7 fAutoSz, ExtCtrls, StdCtrls, ORFn, VA508AccessibilityManager;
[456]8
9type
10 TfrmTimeout = class(TfrmAutoSz)
11 Label1: TStaticText;
12 Label2: TStaticText;
13 cmdContinue: TButton;
14 lblCount: TStaticText;
15 timCountDown: TTimer;
16 procedure FormCreate(Sender: TObject);
17 procedure cmdContinueClick(Sender: TObject);
18 procedure timCountDownTimer(Sender: TObject);
19 private
20 { Private declarations }
21 FContinue: Boolean;
22 FCount: Integer;
23 end;
24
25function AllowTimeout: Boolean;
26
27implementation
28
29{$R *.DFM}
30
31uses uCore;
32
33function AllowTimeout: Boolean;
34var
35 frmTimeout: TfrmTimeout;
36begin
37 frmTimeout := TfrmTimeout.Create(Application);
38 try
39 ResizeFormToFont(TForm(frmTimeout));
40 frmTimeout.ShowModal;
41 Result := not frmTimeout.FContinue;
42 finally
43 frmTimeout.Release;
44 end;
45end;
46
47procedure TfrmTimeout.FormCreate(Sender: TObject);
48begin
49 inherited;
[830]50 Application.Restore;
51 Application.BringToFront;
[456]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.