source: cprs/trunk/CPRS-Chart/fPage.pas@ 1542

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

Upgrading to version 27

File size: 4.4 KB
RevLine 
[456]1unit fPage;
2
3{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
[830]9 rOrders, fBase508Form, VA508AccessibilityManager;
[456]10
11type
[830]12 TfrmPage = class(TfrmBase508Form)
[456]13 shpPageBottom: TShape;
14 procedure FormCreate(Sender: TObject);
15 procedure FormClose(Sender: TObject; var Action: TCloseAction);
16 private
17 FDisplayCount: Integer; // number of times page displayed
18 FPatientCount: Integer; // number of times page displayed for given pt
19 FCallingContext: Integer;
20 FOldEnter: TNotifyEvent;
21 FPageID: integer;
22 function GetInitPage: Boolean;
23 function GetInitPatient: Boolean;
24 function GetPatientViewed: Boolean;
25 protected
26 procedure Loaded; override;
27 procedure frmPageEnter(Sender: TObject);
28 public
29 function AllowContextChange(var WhyNot: string): Boolean; virtual;
30 procedure ClearPtData; virtual;
31 procedure DisplayPage; virtual;
32 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); virtual;
33 procedure RequestPrint; virtual;
34 procedure SetFontSize(NewFontSize: Integer); virtual;
35 procedure FocusFirstControl;
36 property CallingContext: Integer read FCallingContext;
37 property InitPage: Boolean read GetInitPage;
38 property InitPatient: Boolean read GetInitPatient;
39 property PatientViewed: Boolean read GetPatientViewed;
40 property PageID: integer read FPageID write FPageID default CT_UNKNOWN;
41 end;
42
43var
44 frmPage: TfrmPage;
45
46implementation
47
[830]48uses ORFn, fFrame, uInit, VA508AccessibilityRouter;
[456]49
50{$R *.DFM}
51
52procedure TfrmPage.FormCreate(Sender: TObject);
53{ set counters to 0 }
54begin
55 HelpFile := Application.HelpFile + '>' + HelpFile;
56 FDisplayCount := 0;
57 FPatientCount := 0;
58 FOldEnter := OnEnter;
59 OnEnter := frmPageEnter;
60end;
61
62procedure TfrmPage.Loaded;
63{ make the form borderless to allow it to be a child window }
64begin
65 inherited Loaded;
66 Visible := False;
67 Position := poDefault;
68 BorderIcons := [];
69 BorderStyle := bsNone;
70 HandleNeeded;
71 SetBounds(0, 0, Width, Height);
72end;
73
74function TfrmPage.AllowContextChange(var WhyNot: string): Boolean;
75begin
76 Result := True;
77end;
78
79procedure TfrmPage.ClearPtData;
80{ clear all patient related data on a page }
81begin
82 FPatientCount := 0;
83end;
84
85procedure TfrmPage.DisplayPage;
86{ cause the page to be displayed and update the display counters }
87begin
88 BringToFront;
89 if ActiveControl <> nil then
[830]90 FocusControl(ActiveControl);
91 //CQ12232 else
92//CQ12232 FocusFirstControl;
[456]93 //SetFocus;
94 Inc(FDisplayCount);
95 Inc(FPatientCount);
96 FCallingContext := frmFrame.ChangeSource;
97 if (FCallingContext = CC_CLICK) and (FPatientCount = 1)
98 then FCallingContext := CC_INIT_PATIENT;
99end;
100
101procedure TfrmPage.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
102begin
103end;
104
105procedure TfrmPage.RequestPrint;
106begin
107end;
108
109procedure TfrmPage.SetFontSize(NewFontSize: Integer);
110begin
111 ResizeAnchoredFormToFont( self );
112 if Assigned(Parent) then begin
113 Width := Parent.ClientWidth;
114 Height := Parent.ClientHeight;
115 end;
116 Resize;
117end;
118
119function TfrmPage.GetInitPage: Boolean;
120{ if the count is one, this is the first time the page is being displayed }
121begin
122 Result := FDisplayCount = 1;
123end;
124
125function TfrmPage.GetInitPatient: Boolean;
126{ if the count is one, this is the first time the page is being displayed for a given patient }
127begin
128 Result := FPatientCount = 1;
129end;
130
131function TfrmPage.GetPatientViewed: Boolean;
132{ returns false if the tab has never been clicked for this patient }
133begin
134 Result := FPatientCount > 0;
135end;
136
137procedure TfrmPage.FormClose(Sender: TObject; var Action: TCloseAction);
138begin
139 Action := caFree;
140end;
141
142procedure TfrmPage.frmPageEnter(Sender: TObject);
143begin
144 if Assigned(frmFrame) then
145 FrmFrame.tabPage.TabIndex := FrmFrame.PageIDToTab(PageID);
146 if Assigned(FOldEnter) then
147 FOldEnter(Sender);
148end;
149
150procedure TfrmPage.FocusFirstControl;
151var
152 NextControl: TWinControl;
153begin
154 if Assigned(frmFrame) and frmFrame.Enabled and frmFrame.Visible and not uInit.Timedout then begin
155 NextControl := FindNextControl(nil, True, True, False);
156 if NextControl <> nil then
157 NextControl.SetFocus;
158 end;
159end;
160
[830]161initialization
162 SpecifyFormIsNotADialog(TfrmPage);
163
[456]164end.
Note: See TracBrowser for help on using the repository browser.