source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fRptBox.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 8.0 KB
Line 
1unit fRptBox;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORFn, ComCtrls, ExtCtrls, fFrame, fBase508Form,
8 VA508AccessibilityManager, uReports;
9
10type
11 TfrmReportBox = class(TfrmBase508Form)
12 lblFontTest: TLabel;
13 memReport: TRichEdit;
14 pnlButton: TPanel;
15 cmdPrint: TButton;
16 dlgPrintReport: TPrintDialog;
17 cmdClose: TButton;
18 procedure memReportClick(Sender: TObject);
19 procedure cmdPrintClick(Sender: TObject);
20 procedure cmdCloseClick(Sender: TObject);
21 procedure FormClose(Sender: TObject; var Action: TCloseAction);
22 procedure FormResize(Sender: TObject);
23 end;
24
25procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
26function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
27procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
28
29implementation
30
31uses
32 uCore, rCore, rReports, Printers, rMisc;
33
34{$R *.DFM}
35
36function CreateReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
37var
38 i, AWidth, MinWidth, MaxWidth, AHeight: Integer;
39 Rect: TRect;
40 BtnArray: array of TButton;
41 BtnRight: array of integer;
42 BtnLeft: array of integer;
43 //cmdCloseRightMargin: integer;
44 //cmdPrintRightMargin: integer;
45 j, k: integer;
46begin
47 Result := TfrmReportBox.Create(Application);
48 try
49 with Result do
50 begin
51 k := 0;
52 MinWidth := 0;
53 with pnlButton do for j := 0 to ControlCount - 1 do
54 if Controls[j] is TButton then
55 begin
56 SetLength(BtnArray, k+1);
57 SetLength(BtnRight, k+1);
58 BtnArray[j] := TButton(Controls[j]);
59 BtnRight[j] := ResizeWidth(Font, MainFont, BtnArray[j].Width - BtnArray[j].Width - BtnArray[j].Left);
60 k := k + 1;
61 end;
62 //cmdCloseRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdClose.Width - cmdClose.Left);
63 //cmdPrintRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdPrint.Width - cmdPrint.Left);
64 MaxWidth := 350;
65 for i := 0 to ReportText.Count - 1 do
66 begin
67 AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
68 if AWidth > MaxWidth then MaxWidth := AWidth;
69 end;
70 cmdPrint.Visible := AllowPrint;
71 MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL);
72 AHeight := (ReportText.Count * (lblFontTest.Height + 2)) + pnlbutton.Height;
73 AHeight := HigherOf(AHeight, 250);
74 if AHeight > (Screen.Height - 80) then AHeight := Screen.Height - 80;
75 if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
76 ClientWidth := MaxWidth;
77 ClientHeight := AHeight;
78 ResizeAnchoredFormToFont(Result);
79 memReport.Align := alClient; //CQ6661
80 //CQ6889 - force Print & Close buttons to bottom right of form regardless of selected font size
81 cmdClose.Left := (pnlButton.Left+pnlButton.Width)-cmdClose.Width;
82 cmdPrint.Left := (cmdClose.Left-cmdPrint.Width)-1;
83 //end CQ6889
84 SetLength(BtnLeft, k);
85 for j := 0 to k - 1 do
86 begin
87 BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
88 MinWidth := MinWidth + BtnArray[j].Width;
89 end;
90 Width := width + (GetSystemMetrics(SM_CXVSCROLL) *2);
91 Constraints.MinWidth := MinWidth + (MinWidth div 2) + (GetSystemMetrics(SM_CXVSCROLL) *2);
92 if (mainFontSize = 8) then Constraints.MinHeight := 285
93 else if (mainFontSize = 10) then Constraints.MinHeight := 325
94 else if (mainFontSize = 12) then Constraints.MinHeight := 390
95 else if mainFontSize = 14 then Constraints.MinHeight := 460
96 else Constraints.MinHeight := 575;
97 QuickCopy(ReportText, memReport);
98 for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
99 Caption := ReportTitle;
100 memReport.SelStart := 0;
101 Rect := BoundsRect;
102 ForceInsideWorkArea(Rect);
103 BoundsRect := Rect;
104 end;
105 except
106 KillObj(@Result);
107 raise;
108 end;
109end;
110
111procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
112var
113 frmReportBox: TfrmReportBox;
114
115begin
116 Screen.Cursor := crHourglass; //wat cq 18425 added hourglass and disabled mnuFileOpen
117 fFrame.frmFrame.mnuFileOpen.Enabled := False;
118 frmReportBox := CreateReportBox(ReportText, ReportTitle, AllowPrint);
119 try
120 frmReportBox.ShowModal;
121 finally
122 frmReportBox.Release;
123 Screen.Cursor := crDefault;
124 fFrame.frmFrame.mnuFileOpen.Enabled := True;
125 end;
126end;
127
128function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
129begin
130 Result := CreateReportBox(ReportText, ReportTitle, AllowPrint);
131 Result.FormStyle := fsStayOnTop;
132 Result.Show;
133end;
134
135procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
136var
137 AHeader: TStringList;
138 memPrintReport: TRichEdit;
139 MaxLines, LastLine, ThisPage, i: integer;
140 ErrMsg: string;
141// RemoteSiteID: string; //for Remote site printing
142// RemoteQuery: string; //for Remote site printing
143 dlgPrintReport: TPrintDialog;
144 BM: TBitmap;
145const
146 PAGE_BREAK = '**PAGE BREAK**';
147
148begin
149// RemoteSiteID := '';
150// RemoteQuery := '';
151 BM := TBitmap.Create;
152 try
153 dlgPrintReport := TPrintDialog.Create(Form);
154 try
155 frmFrame.CCOWBusy := True;
156 if dlgPrintReport.Execute then
157 begin
158 AHeader := TStringList.Create;
159 CreatePatientHeader(AHeader, Title);
160 memPrintReport := CreateReportTextComponent(Form);
161 try
162 MaxLines := 60 - AHeader.Count;
163 LastLine := 0;
164 ThisPage := 0;
165 BM.Canvas.Font := memPrintReport.Font;
166 with memPrintReport do
167 begin
168 repeat
169 with Lines do
170 begin
171 for i := 0 to MaxLines do begin
172 if BM.Canvas.TextWidth(StringText[LastLine + i]) > Width then begin
173 MaxLines := Maxlines - (BM.Canvas.TextWidth(StringText[LastLine + i]) div Width);
174 end;
175 if i >= MaxLines then begin
176 break;
177 end;
178
179 if i < StringText.Count then
180 // Add(IntToStr(i) + ') ' + StringText[LastLine + i])
181 Add(StringText[LastLine + i])
182 else
183 Break;
184 end;
185
186 LastLine := LastLine + i;
187 Add(' ');
188 Add(' ');
189 Add(StringOfChar('-', 74));
190 if LastLine >= StringText.Count - 1 then
191 Add(Trailer)
192 else
193 begin
194 ThisPage := ThisPage + 1;
195 Add('Page ' + IntToStr(ThisPage));
196 Add(PAGE_BREAK);
197 MaxLines := 60 - AHeader.Count;
198 end;
199 end;
200 until LastLine >= StringText.Count - 1;
201 PrintWindowsReport(memPrintReport, PAGE_BREAK, Title, ErrMsg, True);
202 end;
203 finally
204 memPrintReport.Free;
205 AHeader.Free;
206 end;
207 end;
208 finally
209 frmFrame.CCOWBusy := False;
210 dlgPrintReport.Free;
211 end;
212 finally
213 BM.free;
214 end;
215end;
216
217procedure TfrmReportBox.memReportClick(Sender: TObject);
218begin
219 //Close;
220end;
221
222procedure TfrmReportBox.cmdPrintClick(Sender: TObject);
223begin
224 PrintStrings(Self, memReport.Lines, Self.Caption, 'End of report');
225 memReport.Invalidate;
226end;
227
228procedure TfrmReportBox.cmdCloseClick(Sender: TObject);
229begin
230 Close;
231end;
232
233procedure TfrmReportBox.FormClose(Sender: TObject; var Action: TCloseAction);
234begin
235 if(not (fsModal in FormState)) then
236 Action := caFree;
237end;
238
239
240procedure TfrmReportBox.FormResize(Sender: TObject);
241begin
242 inherited;
243 self.memReport.Refresh;
244end;
245
246end.
Note: See TracBrowser for help on using the repository browser.