| 1 | unit fPage;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | {$OPTIMIZATION OFF}                              // REMOVE AFTER UNIT IS DEBUGGED
 | 
|---|
| 4 | 
 | 
|---|
| 5 | interface
 | 
|---|
| 6 | 
 | 
|---|
| 7 | uses
 | 
|---|
| 8 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, uConst,
 | 
|---|
| 9 |   rOrders;
 | 
|---|
| 10 | 
 | 
|---|
| 11 | type
 | 
|---|
| 12 |   TfrmPage = class(TForm)
 | 
|---|
| 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 | 
 | 
|---|
| 43 | var
 | 
|---|
| 44 |   frmPage: TfrmPage;
 | 
|---|
| 45 | 
 | 
|---|
| 46 | implementation
 | 
|---|
| 47 | 
 | 
|---|
| 48 | uses ORFn, fFrame, uInit;
 | 
|---|
| 49 | 
 | 
|---|
| 50 | {$R *.DFM}
 | 
|---|
| 51 | 
 | 
|---|
| 52 | procedure TfrmPage.FormCreate(Sender: TObject);
 | 
|---|
| 53 | { set counters to 0 }
 | 
|---|
| 54 | begin
 | 
|---|
| 55 |   HelpFile := Application.HelpFile + '>' + HelpFile;
 | 
|---|
| 56 |   FDisplayCount := 0;
 | 
|---|
| 57 |   FPatientCount := 0;
 | 
|---|
| 58 |   FOldEnter := OnEnter;
 | 
|---|
| 59 |   OnEnter := frmPageEnter;
 | 
|---|
| 60 | end;
 | 
|---|
| 61 | 
 | 
|---|
| 62 | procedure TfrmPage.Loaded;
 | 
|---|
| 63 | { make the form borderless to allow it to be a child window }
 | 
|---|
| 64 | begin
 | 
|---|
| 65 |   inherited Loaded;
 | 
|---|
| 66 |   Visible := False;
 | 
|---|
| 67 |   Position := poDefault;
 | 
|---|
| 68 |   BorderIcons := [];
 | 
|---|
| 69 |   BorderStyle := bsNone;
 | 
|---|
| 70 |   HandleNeeded;
 | 
|---|
| 71 |   SetBounds(0, 0, Width, Height);
 | 
|---|
| 72 | end;
 | 
|---|
| 73 | 
 | 
|---|
| 74 | function TfrmPage.AllowContextChange(var WhyNot: string): Boolean;
 | 
|---|
| 75 | begin
 | 
|---|
| 76 |   Result := True;
 | 
|---|
| 77 | end;
 | 
|---|
| 78 | 
 | 
|---|
| 79 | procedure TfrmPage.ClearPtData;
 | 
|---|
| 80 | { clear all patient related data on a page }
 | 
|---|
| 81 | begin
 | 
|---|
| 82 |   FPatientCount := 0;
 | 
|---|
| 83 | end;
 | 
|---|
| 84 | 
 | 
|---|
| 85 | procedure TfrmPage.DisplayPage;
 | 
|---|
| 86 | { cause the page to be displayed and update the display counters }
 | 
|---|
| 87 | begin
 | 
|---|
| 88 |   BringToFront;
 | 
|---|
| 89 |   if ActiveControl <> nil then
 | 
|---|
| 90 |     FocusControl(ActiveControl)
 | 
|---|
| 91 |   else
 | 
|---|
| 92 |     FocusFirstControl;
 | 
|---|
| 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;
 | 
|---|
| 99 | end;
 | 
|---|
| 100 | 
 | 
|---|
| 101 | procedure TfrmPage.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
 | 
|---|
| 102 | begin
 | 
|---|
| 103 | end;
 | 
|---|
| 104 | 
 | 
|---|
| 105 | procedure TfrmPage.RequestPrint;
 | 
|---|
| 106 | begin
 | 
|---|
| 107 | end;
 | 
|---|
| 108 | 
 | 
|---|
| 109 | procedure TfrmPage.SetFontSize(NewFontSize: Integer);
 | 
|---|
| 110 | begin
 | 
|---|
| 111 |   ResizeAnchoredFormToFont( self );
 | 
|---|
| 112 |   if Assigned(Parent) then begin
 | 
|---|
| 113 |     Width := Parent.ClientWidth;
 | 
|---|
| 114 |     Height := Parent.ClientHeight;
 | 
|---|
| 115 |   end;
 | 
|---|
| 116 |   Resize;
 | 
|---|
| 117 | end;
 | 
|---|
| 118 | 
 | 
|---|
| 119 | function TfrmPage.GetInitPage: Boolean;
 | 
|---|
| 120 | { if the count is one, this is the first time the page is being displayed }
 | 
|---|
| 121 | begin
 | 
|---|
| 122 |   Result := FDisplayCount = 1;
 | 
|---|
| 123 | end;
 | 
|---|
| 124 | 
 | 
|---|
| 125 | function TfrmPage.GetInitPatient: Boolean;
 | 
|---|
| 126 | { if the count is one, this is the first time the page is being displayed for a given patient }
 | 
|---|
| 127 | begin
 | 
|---|
| 128 |   Result := FPatientCount = 1;
 | 
|---|
| 129 | end;
 | 
|---|
| 130 | 
 | 
|---|
| 131 | function TfrmPage.GetPatientViewed: Boolean;
 | 
|---|
| 132 | { returns false if the tab has never been clicked for this patient }
 | 
|---|
| 133 | begin
 | 
|---|
| 134 |   Result := FPatientCount > 0;
 | 
|---|
| 135 | end;
 | 
|---|
| 136 | 
 | 
|---|
| 137 | procedure TfrmPage.FormClose(Sender: TObject; var Action: TCloseAction);
 | 
|---|
| 138 | begin
 | 
|---|
| 139 |   Action := caFree;
 | 
|---|
| 140 | end;
 | 
|---|
| 141 | 
 | 
|---|
| 142 | procedure TfrmPage.frmPageEnter(Sender: TObject);
 | 
|---|
| 143 | begin
 | 
|---|
| 144 |   if Assigned(frmFrame) then
 | 
|---|
| 145 |     FrmFrame.tabPage.TabIndex := FrmFrame.PageIDToTab(PageID);
 | 
|---|
| 146 |   if Assigned(FOldEnter) then
 | 
|---|
| 147 |     FOldEnter(Sender);
 | 
|---|
| 148 | end;
 | 
|---|
| 149 | 
 | 
|---|
| 150 | procedure TfrmPage.FocusFirstControl;
 | 
|---|
| 151 | var
 | 
|---|
| 152 |   NextControl: TWinControl;
 | 
|---|
| 153 | begin
 | 
|---|
| 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;
 | 
|---|
| 159 | end;
 | 
|---|
| 160 | 
 | 
|---|
| 161 | end.
 | 
|---|