Module

fTimeout

Path

C:\CPRS\CPRS30\fTimeout.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
uCore -

Classes

Name Comments
TfrmTimeout -

Procedures

Name Owner Declaration Scope Comments
btnCloseClick TfrmTimeout procedure btnCloseClick(Sender: TObject); Public/Published -
cmdContinueClick TfrmTimeout procedure cmdContinueClick(Sender: TObject); Public/Published -
FormCreate TfrmTimeout procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmTimeout procedure FormShow(Sender: TObject); Public/Published -
timCountDownTimer TfrmTimeout procedure timCountDownTimer(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
AllowTimeout - function AllowTimeout: Boolean; Interfaced -


Module Source

1     unit fTimeout;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, ExtCtrls, StdCtrls, ORFn, VA508AccessibilityManager;
8     
9     type
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    
36    function AllowTimeout: Boolean;
37    
38    implementation
39    
40    {$R *.DFM}
41    
42    uses uCore;
43    
44    function AllowTimeout: Boolean;
45    var
46      frmTimeout: TfrmTimeout;
47    begin
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;
56    end;
57    
58    procedure TfrmTimeout.FormCreate(Sender: TObject);
59    begin
60      inherited;
61      Application.Restore;
62      Application.BringToFront;
63      MessageBeep(MB_ICONASTERISK);
64      FCount := User.CountDown;
65      lblCount.Caption := IntToStr(FCount);
66    end;
67    
68    procedure TfrmTimeout.FormShow(Sender: TObject);
69    begin
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;
79    end;
80    
81    procedure TfrmTimeout.btnCloseClick(Sender: TObject);
82    begin
83      inherited;
84      FContinue := False;
85      Close;
86    end;
87    
88    procedure TfrmTimeout.cmdContinueClick(Sender: TObject);
89    begin
90      inherited;
91      FContinue := True;
92      Close;
93    end;
94    
95    procedure TfrmTimeout.timCountDownTimer(Sender: TObject);
96    begin
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;
112   end;
113   
114   end.

Module Calls (2 levels)


fTimeout
 ├fAutoSz
 │ └fBase508Form
 └uCore
   ├rCore
   ├uConst
   ├uCombatVet
   ├rTIU
   ├rOrders
   ├rConsults
   └uOrders

Module Called-By (2 levels)


           fTimeout
            uInit┘ 
          fPage┤   
         fFrame┤   
        fOrders┤   
fTemplateDialog┤   
     uReminders┤   
         fCover┤   
         fNotes┤   
       fProbEdt┤   
       fProbLex┤   
         uSpell┘