source: cprs/branches/tmg-cprs/CPRS-Chart/fPage.pas@ 1806

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

Initial upload of TMG-CPRS 1.0.26.69

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