source: cprs/branches/foia-cprs/CPRS-Chart/Consults/fPreReq.pas@ 1245

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

Adding foia-cprs branch

File size: 5.7 KB
Line 
1unit fPreReq;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORFn, ComCtrls, ExtCtrls;
8
9type
10 TfrmPrerequisites = class(TForm)
11 lblFontTest: TLabel;
12 memReport: TRichEdit;
13 pnlButton: TPanel;
14 cmdContinue: TButton;
15 cmdCancel: TButton;
16 cmdPrint: TButton;
17 dlgPrintReport: TPrintDialog;
18 procedure memReportClick(Sender: TObject);
19 procedure cmdContinueClick(Sender: TObject);
20 procedure cmdCancelClick(Sender: TObject);
21 procedure cmdPrintClick(Sender: TObject);
22 procedure FormCreate(Sender: TObject);
23 procedure FormClose(Sender: TObject; var Action: TCloseAction);
24 procedure FormShow(Sender: TObject);
25 private
26 procedure AlignButtons();
27 end;
28
29function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean;
30
31var
32 ContinueWithOrder: Boolean;
33
34implementation
35
36uses
37 uCore, rCore, rReports, Printers,rMisc;
38
39{$R *.DFM}
40
41function CreateReportBox(ReportText: TStrings; ReportTitle: string): TfrmPrerequisites;
42var
43 i, AWidth, MaxWidth, AHeight: Integer;
44 Rect: TRect;
45begin
46 Result := TfrmPrerequisites.Create(Application);
47 try
48 with Result do
49 begin
50 MaxWidth := PnlButton.Width;
51 for i := 0 to ReportText.Count - 1 do
52 begin
53 AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
54 if AWidth > MaxWidth then MaxWidth := AWidth;
55 end;
56 MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2) + GetSystemMetrics(SM_CXVSCROLL);
57 AHeight := (ReportText.Count * lblFontTest.Height) + ReportText.Count +
58 (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION);
59 AHeight := AHeight + pnlbutton.Height;
60 AHeight := HigherOf(AHeight, 250);
61 if AHeight > (Screen.Height - 60) then AHeight := Screen.Height - 60;
62 if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
63 Width := MaxWidth;
64 Height := AHeight;
65 Rect := BoundsRect;
66 ForceInsideWorkArea(Rect);
67 BoundsRect := Rect;
68 memReport.Lines.Assign(ReportText);
69 ResizeAnchoredFormToFont(result);
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 := TRichEdit.Create(Self);
130 try
131 MaxLines := 60 - AHeader.Count;
132 LastLine := 0;
133 ThisPage := 0;
134 with memPrintReport do
135 begin
136 Visible := False;
137 Parent := Self;
138 Font.Name := 'Courier New';
139 Font.Size := MainFontSize;
140 Width := Printer.Canvas.TextWidth(StringOfChar('-', 74));
141 //Width := 600;
142 repeat
143 with Lines do
144 begin
145 AddStrings(AHeader);
146 for i := 0 to MaxLines do
147 if i < memReport.Lines.Count then
148 Add(memReport.Lines[LastLine + i])
149 else
150 Break;
151 LastLine := LastLine + i;
152 Add(' ');
153 Add(' ');
154 Add(StringOfChar('-', 74));
155 if LastLine >= memReport.Lines.Count - 1 then
156 Add('End of report')
157 else
158 begin
159 ThisPage := ThisPage + 1;
160 Add('Page ' + IntToStr(ThisPage));
161 Add(PAGE_BREAK);
162 end;
163 end;
164 until LastLine >= memReport.Lines.Count - 1;
165 PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg);
166 end;
167 finally
168 memPrintReport.Free;
169 AHeader.Free;
170 end;
171 end;
172 memReport.SelStart := 0;
173 memReport.Invalidate;
174end;
175
176procedure TfrmPrerequisites.FormCreate(Sender: TObject);
177begin
178 memreport.Color := ReadOnlyColor;
179
180end;
181
182procedure TfrmPrerequisites.AlignButtons;
183Const
184 BtnSpace = 8;
185begin
186 cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace;
187 cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width;
188end;
189
190procedure TfrmPrerequisites.FormClose(Sender: TObject;
191 var Action: TCloseAction);
192begin
193 SaveUserBounds(Self); //Save Position & Size of Form
194end;
195
196procedure TfrmPrerequisites.FormShow(Sender: TObject);
197begin
198 SetFormPosition(Self); //Get Saved Position & Size of Form
199end;
200
201end.
Note: See TracBrowser for help on using the repository browser.