source: cprs/trunk/CPRS-Chart/Consults/fPreReq.pas@ 1071

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

Upgrade to version 27

File size: 5.6 KB
Line 
1unit fPreReq;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORFn, ComCtrls, ExtCtrls, fBase508Form, VA508AccessibilityManager,
8 uReports;
9
10type
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
30function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean;
31
32var
33 ContinueWithOrder: Boolean;
34
35implementation
36
37uses
38 uCore, rCore, rReports, Printers, rMisc;
39
40{$R *.DFM}
41
42function CreateReportBox(ReportText: TStrings; ReportTitle: string): TfrmPrerequisites;
43var
44 i, AWidth, MaxWidth, AHeight: Integer;
45 Rect: TRect;
46begin
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;
80end;
81
82function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean;
83var
84 frmPrerequisites: TfrmPrerequisites;
85begin
86 frmPrerequisites := CreateReportBox(ReportText, ReportTitle);
87 try
88 frmPrerequisites.ShowModal;
89 Result := ContinueWithOrder;
90 finally
91 frmPrerequisites.Release;
92 end;
93end;
94
95procedure TfrmPrerequisites.memReportClick(Sender: TObject);
96begin
97 //Close;
98end;
99
100procedure TfrmPrerequisites.cmdContinueClick(Sender: TObject);
101begin
102 ContinueWithOrder := True;
103 Close;
104end;
105
106procedure TfrmPrerequisites.cmdCancelClick(Sender: TObject);
107begin
108 ContinueWithOrder := False;
109 Close;
110end;
111
112procedure TfrmPrerequisites.cmdPrintClick(Sender: TObject);
113var
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
120const
121 PAGE_BREAK = '**PAGE BREAK**';
122begin
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 AddStrings(AHeader);
140 for i := 0 to MaxLines do
141 if i < memReport.Lines.Count then
142 Add(memReport.Lines[LastLine + i])
143 else
144 Break;
145 LastLine := LastLine + i;
146 Add(' ');
147 Add(' ');
148 Add(StringOfChar('-', 74));
149 if LastLine >= memReport.Lines.Count - 1 then
150 Add('End of report')
151 else
152 begin
153 ThisPage := ThisPage + 1;
154 Add('Page ' + IntToStr(ThisPage));
155 Add(PAGE_BREAK);
156 end;
157 end;
158 until LastLine >= memReport.Lines.Count - 1;
159 PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg);
160 end;
161 finally
162 memPrintReport.Free;
163 AHeader.Free;
164 end;
165 end;
166 memReport.SelStart := 0;
167 memReport.Invalidate;
168end;
169
170procedure TfrmPrerequisites.AlignButtons;
171Const
172 BtnSpace = 8;
173begin
174 cmdCancel.Left := self.Width - cmdCancel.Width - (BtnSpace * 3) - 3;
175 cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width;
176end;
177
178procedure TfrmPrerequisites.FormClose(Sender: TObject;
179 var Action: TCloseAction);
180begin
181 SaveUserBounds(Self); //Save Position & Size of Form
182end;
183
184procedure TfrmPrerequisites.FormCreate(Sender: TObject);
185begin
186 inherited;
187 ResizeAnchoredFormToFont(Self);
188 SetFormPosition(Self); //Get Saved Position & Size of Form
189end;
190
191procedure TfrmPrerequisites.OnActivate(Sender: TObject);
192begin
193 if Self.VertScrollBar.IsScrollBarVisible then Self.VertScrollBar.Position := 0;
194end;
195end.
Note: See TracBrowser for help on using the repository browser.