source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fPreReq.pas@ 1641

Last change on this file since 1641 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing

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