Module

fPreReq

Path

C:\CPRS\CPRS30\Consults\fPreReq.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fBase508Form -
uReports -

Units Used in Implementation

Name Comments
rCore -
rMisc -
rReports -
uCore -

Classes

Name Comments
TfrmPrerequisites -

Procedures

Name Owner Declaration Scope Comments
AlignButtons TfrmPrerequisites procedure AlignButtons(); Private -
cmdCancelClick TfrmPrerequisites procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdContinueClick TfrmPrerequisites procedure cmdContinueClick(Sender: TObject); Public/Published -
cmdPrintClick TfrmPrerequisites procedure cmdPrintClick(Sender: TObject); Public/Published -
FormClose TfrmPrerequisites procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPrerequisites procedure FormCreate(Sender: TObject); Public/Published -
memReportClick TfrmPrerequisites procedure memReportClick(Sender: TObject); Public/Published -
OnActivate TfrmPrerequisites procedure OnActivate(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
CreateReportBox - function CreateReportBox(ReportText: TStrings; ReportTitle: string): TfrmPrerequisites; Global -
DisplayPrerequisites - function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean; Interfaced -

Global Variables

Name Type Declaration Comments
ContinueWithOrder Boolean ContinueWithOrder: Boolean; -


Module Source

1     unit fPreReq;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager,
8       uReports;
9     
10    type
11      TfrmPrerequisites = class(TfrmBase508Form)
12        lblFontTest: TLabel;
13        memReport: TRichEdit;
14        pnlButton: TPanel;
15        cmdContinue: TButton;
16        cmdCancel: TButton;
17        cmdPrint: TButton;
18        dlgPrintReport: TPrintDialog;
19        procedure memReportClick(Sender: TObject);
20        procedure cmdContinueClick(Sender: TObject);
21        procedure cmdCancelClick(Sender: TObject);
22        procedure cmdPrintClick(Sender: TObject);
23        procedure FormClose(Sender: TObject; var Action: TCloseAction);
24        procedure OnActivate(Sender: TObject);
25        procedure FormCreate(Sender: TObject);
26      private
27        procedure AlignButtons();
28      end;
29    
30    function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean;
31    
32    var
33      ContinueWithOrder: Boolean;
34    
35    implementation
36    
37    uses
38      uCore, rCore, rReports, Printers, rMisc;
39    
40    {$R *.DFM}
41    
42    function CreateReportBox(ReportText: TStrings; ReportTitle: string): TfrmPrerequisites;
43    var
44      i, AWidth, MaxWidth, AHeight: Integer;
45      Rect: TRect;
46    begin
47      Result := TfrmPrerequisites.Create(Application);
48      try
49        with Result do
50        begin
51          MaxWidth := PnlButton.Width;
52          for i := 0 to ReportText.Count - 1 do
53          begin
54            AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
55            if AWidth > MaxWidth then MaxWidth := AWidth;
56          end;
57          MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2) + GetSystemMetrics(SM_CXVSCROLL);
58          AHeight := (ReportText.Count * lblFontTest.Height) + ReportText.Count +
59            (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION);
60          AHeight := AHeight + pnlbutton.Height;
61          AHeight := HigherOf(AHeight, 250);
62          if AHeight > (Screen.Height - 60) then AHeight := Screen.Height - 60;
63          if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
64          Width := MaxWidth;
65          Height := AHeight;
66          Rect := BoundsRect;
67          ForceInsideWorkArea(Rect);
68          BoundsRect := Rect;
69          QuickCopy(ReportText, memReport);
70          //Quick fix to work around glich in resize algorithim
71          AlignButtons();
72          for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
73          Caption := ReportTitle;
74          memReport.SelStart := 0;
75        end;
76      except
77        KillObj(@Result);
78        raise;
79      end;
80    end;
81    
82    function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean;
83    var
84      frmPrerequisites: TfrmPrerequisites;
85    begin
86      frmPrerequisites := CreateReportBox(ReportText, ReportTitle);
87      try
88        frmPrerequisites.ShowModal;
89        Result := ContinueWithOrder;
90      finally
91        frmPrerequisites.Release;
92      end;
93    end;
94    
95    procedure TfrmPrerequisites.memReportClick(Sender: TObject);
96    begin
97      //Close;
98    end;
99    
100   procedure TfrmPrerequisites.cmdContinueClick(Sender: TObject);
101   begin
102     ContinueWithOrder := True;
103     Close;
104   end;
105   
106   procedure TfrmPrerequisites.cmdCancelClick(Sender: TObject);
107   begin
108     ContinueWithOrder := False;
109     Close;
110   end;
111   
112   procedure TfrmPrerequisites.cmdPrintClick(Sender: TObject);
113   var
114     AHeader: TStringList;
115     memPrintReport: TRichEdit;
116     MaxLines, LastLine, ThisPage, i: integer;
117     ErrMsg: string;
118     RemoteSiteID: string;    //for Remote site printing
119     RemoteQuery: string;    //for Remote site printing
120   const
121     PAGE_BREAK = '**PAGE BREAK**';
122   begin
123     RemoteSiteID := '';
124     RemoteQuery := '';
125     if dlgPrintReport.Execute then
126       begin
127         AHeader := TStringList.Create;
128         CreatePatientHeader(AHeader, Self.Caption);
129         memPrintReport := CreateReportTextComponent(Self);
130         try
131           MaxLines := 60 - AHeader.Count;
132           LastLine := 0;
133           ThisPage := 0;
134           with memPrintReport do
135             begin
136               repeat
137                 with Lines do
138                   begin
139                     for i := 0 to MaxLines do
140                       if i < memReport.Lines.Count then
141                         Add(memReport.Lines[LastLine + i])
142                       else
143                         Break;
144                     LastLine := LastLine + i;
145                     Add(' ');
146                     Add(' ');
147                     Add(StringOfChar('-', 74));
148                     if LastLine >= memReport.Lines.Count - 1 then
149                       Add('End of report')
150                     else
151                       begin
152                         ThisPage := ThisPage + 1;
153                         Add('Page ' + IntToStr(ThisPage));
154                         Add(PAGE_BREAK);
155                       end;
156                   end;
157                 until LastLine >= memReport.Lines.Count - 1;
158               PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True);
159             end;
160         finally
161           memPrintReport.Free;
162           AHeader.Free;
163         end;
164       end;
165     memReport.SelStart := 0;
166     memReport.Invalidate;
167   end;
168   
169   procedure TfrmPrerequisites.AlignButtons;
170   Const
171     BtnSpace = 8;
172   begin
173     cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3;
174     cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width;
175   end;
176   
177   procedure TfrmPrerequisites.FormClose(Sender: TObject;
178     var Action: TCloseAction);
179   begin
180     SaveUserBounds(Self); //Save Position & Size of Form
181   end;
182   
183   procedure TfrmPrerequisites.FormCreate(Sender: TObject);
184   begin
185     inherited;
186     SetFormPosition(Self); //Get Saved Position & Size of Form
187     ResizeAnchoredFormToFont(Self);
188     //SetFormPosition(Self); //Get Saved Position & Size of Form
189   end;
190   
191   procedure TfrmPrerequisites.OnActivate(Sender: TObject);
192   begin
193     if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0;
194   end;
195   end.

Module Calls (2 levels)


fPreReq
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uReports
 ├rReports
 │ ├uCore
 │ ├rCore
 │ └uReports
 └rMisc
   └fOrders

Module Called-By (2 levels)


              fPreReq
         fODConsult┤ 
          uOrders┤ │ 
          fOrders┤ │ 
fBALocalDiagnoses┘ │ 
            fODProc┘ 
       uOrders...┘