source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fTimeout.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 2.5 KB
Line 
1unit fTimeout;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, ExtCtrls, StdCtrls, ORFn, VA508AccessibilityManager;
8
9type
10 TfrmTimeout = class(TfrmAutoSz)
11 timCountDown: TTimer;
12 pnlTop: TPanel;
13 Label1: TStaticText;
14 Label2: TStaticText;
15 pnlBottom: TPanel;
16 btnClose: TButton;
17 cmdContinue: TButton;
18 lblCount: TStaticText;
19 pnlWarning: TPanel;
20 imgWarning: TImage;
21 lblWarning: TLabel;
22 lblWarningMultiple: TLabel;
23 lblWarningContinue: TLabel;
24 lblWarningPatient: TLabel;
25 procedure FormCreate(Sender: TObject);
26 procedure cmdContinueClick(Sender: TObject);
27 procedure timCountDownTimer(Sender: TObject);
28 procedure FormShow(Sender: TObject);
29 procedure btnCloseClick(Sender: TObject);
30 private
31 { Private declarations }
32 FContinue: Boolean;
33 FCount: Integer;
34 end;
35
36function AllowTimeout: Boolean;
37
38implementation
39
40{$R *.DFM}
41
42uses uCore;
43
44function AllowTimeout: Boolean;
45var
46 frmTimeout: TfrmTimeout;
47begin
48 frmTimeout := TfrmTimeout.Create(Application);
49 try
50 ResizeFormToFont(TForm(frmTimeout));
51 frmTimeout.ShowModal;
52 Result := not frmTimeout.FContinue;
53 finally
54 frmTimeout.Release;
55 end;
56end;
57
58procedure TfrmTimeout.FormCreate(Sender: TObject);
59begin
60 inherited;
61 Application.Restore;
62 Application.BringToFront;
63 MessageBeep(MB_ICONASTERISK);
64 FCount := User.CountDown;
65 lblCount.Caption := IntToStr(FCount);
66end;
67
68procedure TfrmTimeout.FormShow(Sender: TObject);
69begin
70 inherited;
71 SetForegroundWindow(Handle);
72 lblWarningPatient.Caption := Patient.Name;
73 lblWarning.Font.Size := lblWarningPatient.Font.Size + 4;
74 if CPRSInstances < 2 then
75 begin
76 pnlWarning.Visible := false;
77 Height := Height - pnlWarning.Height;
78 end;
79end;
80
81procedure TfrmTimeout.btnCloseClick(Sender: TObject);
82begin
83 inherited;
84 FContinue := False;
85 Close;
86end;
87
88procedure TfrmTimeout.cmdContinueClick(Sender: TObject);
89begin
90 inherited;
91 FContinue := True;
92 Close;
93end;
94
95procedure TfrmTimeout.timCountDownTimer(Sender: TObject);
96begin
97 inherited;
98 if FCount = User.CountDown then
99 begin
100 MessageBeep(MB_ICONASTERISK);
101 timCountDown.Enabled := False;
102 timCountDown.Interval := 1000;
103 timCountDown.Enabled := True;
104 end;
105 Dec(FCount);
106 lblCount.Caption := IntToStr(FCount);
107 if FCount < 1 then
108 begin
109 timCountDown.Enabled := False;
110 Close;
111 end;
112end;
113
114end.
Note: See TracBrowser for help on using the repository browser.