source: cprs/trunk/CPRS-Chart/fRptBox.pas@ 924

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

Upgrading to version 27

File size: 6.7 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 end;
23
24procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
25function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
26procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
27
28implementation
29
30uses
31 uCore, rCore, rReports, Printers, rMisc;
32
33{$R *.DFM}
34
35function CreateReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
36var
37 i, AWidth, MaxWidth, AHeight: Integer;
38 Rect: TRect;
39 // %$@# buttons!
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 with pnlButton do for j := 0 to ControlCount - 1 do
53 if Controls[j] is TButton then
54 begin
55 SetLength(BtnArray, k+1);
56 SetLength(BtnRight, k+1);
57 BtnArray[j] := TButton(Controls[j]);
58 BtnRight[j] := ResizeWidth(Font, MainFont, BtnArray[j].Width - BtnArray[j].Width - BtnArray[j].Left);
59 k := k + 1;
60 end;
61 //cmdCloseRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdClose.Width - cmdClose.Left);
62 //cmdPrintRightMargin := ResizeWidth(Font, MainFont, pnlButton.Width - cmdPrint.Width - cmdPrint.Left);
63 MaxWidth := 350;
64 for i := 0 to ReportText.Count - 1 do
65 begin
66 AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]);
67 if AWidth > MaxWidth then MaxWidth := AWidth;
68 end;
69 cmdPrint.Visible := AllowPrint;
70 MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL);
71 AHeight := (ReportText.Count * (lblFontTest.Height + 2)) + pnlbutton.Height;
72 AHeight := HigherOf(AHeight, 250);
73 if AHeight > (Screen.Height - 80) then AHeight := Screen.Height - 80;
74 if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
75 ClientWidth := MaxWidth;
76 ClientHeight := AHeight;
77 Rect := BoundsRect;
78 ForceInsideWorkArea(Rect);
79 BoundsRect := Rect;
80 ResizeAnchoredFormToFont(Result);
81
82 memReport.Align := alClient; //CQ6661
83
84 //CQ6889 - force Print & Close buttons to bottom right of form regardless of selected font size
85 cmdClose.Left := (pnlButton.Left+pnlButton.Width)-cmdClose.Width;
86 cmdPrint.Left := (cmdClose.Left-cmdPrint.Width)-1;
87 //end CQ6889
88
89 SetLength(BtnLeft, k);
90 for j := 0 to k - 1 do
91 begin
92 BtnLeft[j] := pnlButton.Width - BtnArray[j].Width - BtnRight[j];
93 end;
94 //cmdClose.Left := pnlButton.Width - cmdClose.Width - cmdCloseRightMargin;
95 //cmdPrint.Left := pnlButton.Width - cmdPrint.Width - cmdPrintRightMargin;
96 QuickCopy(ReportText, memReport);
97 for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' ';
98 Caption := ReportTitle;
99 memReport.SelStart := 0;
100 end;
101 except
102 KillObj(@Result);
103 raise;
104 end;
105end;
106
107procedure ReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean);
108var
109 frmReportBox: TfrmReportBox;
110
111begin
112 frmReportBox := CreateReportBox(ReportText, ReportTitle, AllowPrint);
113 try
114 frmReportBox.ShowModal;
115 finally
116 frmReportBox.Release;
117 end;
118end;
119
120function ModelessReportBox(ReportText: TStrings; ReportTitle: string; AllowPrint: boolean): TfrmReportBox;
121begin
122 Result := CreateReportBox(ReportText, ReportTitle, AllowPrint);
123 Result.FormStyle := fsStayOnTop;
124 Result.Show;
125end;
126
127procedure PrintStrings(Form: TForm; StringText: TStrings; const Title, Trailer: string);
128var
129 AHeader: TStringList;
130 memPrintReport: TRichEdit;
131 MaxLines, LastLine, ThisPage, i: integer;
132 ErrMsg: string;
133// RemoteSiteID: string; //for Remote site printing
134// RemoteQuery: string; //for Remote site printing
135 dlgPrintReport: TPrintDialog;
136
137const
138 PAGE_BREAK = '**PAGE BREAK**';
139
140begin
141// RemoteSiteID := '';
142// RemoteQuery := '';
143 dlgPrintReport := TPrintDialog.Create(Form);
144 try
145 frmFrame.CCOWBusy := True;
146 if dlgPrintReport.Execute then
147 begin
148 AHeader := TStringList.Create;
149 CreatePatientHeader(AHeader, Title);
150 memPrintReport := CreateReportTextComponent(Form);
151 try
152 MaxLines := 60 - AHeader.Count;
153 LastLine := 0;
154 ThisPage := 0;
155 with memPrintReport do
156 begin
157 repeat
158 with Lines do
159 begin
160 AddStrings(AHeader);
161 for i := 0 to MaxLines do
162 if i < StringText.Count then
163 Add(StringText[LastLine + i])
164 else
165 Break;
166 LastLine := LastLine + i;
167 Add(' ');
168 Add(' ');
169 Add(StringOfChar('-', 74));
170 if LastLine >= StringText.Count - 1 then
171 Add(Trailer)
172 else
173 begin
174 ThisPage := ThisPage + 1;
175 Add('Page ' + IntToStr(ThisPage));
176 Add(PAGE_BREAK);
177 end;
178 end;
179 until LastLine >= StringText.Count - 1;
180 PrintWindowsReport(memPrintReport, PAGE_BREAK, Title, ErrMsg);
181 end;
182 finally
183 memPrintReport.Free;
184 AHeader.Free;
185 end;
186 end;
187 finally
188 frmFrame.CCOWBusy := False;
189 dlgPrintReport.Free;
190 end;
191end;
192
193procedure TfrmReportBox.memReportClick(Sender: TObject);
194begin
195 //Close;
196end;
197
198procedure TfrmReportBox.cmdPrintClick(Sender: TObject);
199begin
200 PrintStrings(Self, memReport.Lines, Self.Caption, 'End of report');
201 memReport.Invalidate;
202end;
203
204procedure TfrmReportBox.cmdCloseClick(Sender: TObject);
205begin
206 Close;
207end;
208
209procedure TfrmReportBox.FormClose(Sender: TObject; var Action: TCloseAction);
210begin
211 if(not (fsModal in FormState)) then
212 Action := caFree;
213end;
214
215end.
Note: See TracBrowser for help on using the repository browser.