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

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 7.0 KB
Line 
1unit fRptBox;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORFn, ComCtrls, ExtCtrls, fFrame;
8
9type
10 TfrmReportBox = class(TForm)
11 lblFontTest: TLabel;
12 memReport: TRichEdit;
13 pnlButton: TPanel;
14 cmdPrint: TButton;
15 dlgPrintReport: TPrintDialog;
16 cmdClose: TButton;
17 procedure memReportClick(Sender: TObject);
18 procedure cmdPrintClick(Sender: TObject);
19 procedure cmdCloseClick(Sender: TObject);
20 procedure FormClose(Sender: TObject; var Action: TCloseAction);
21 procedure FormCreate(Sender: TObject);
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 memReport.Lines.Assign(ReportText);
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 := TRichEdit.Create(Form);
151 try
152 MaxLines := 60 - AHeader.Count;
153 LastLine := 0;
154 ThisPage := 0;
155 with memPrintReport do
156 begin
157 Visible := False;
158 Parent := Form;
159 Font.Name := 'Courier New';
160 Font.Size := MainFontSize;
161 Width := Printer.Canvas.TextWidth(StringOfChar('-', 74));
162 //Width := 600;
163 repeat
164 with Lines do
165 begin
166 AddStrings(AHeader);
167 for i := 0 to MaxLines do
168 if i < StringText.Count then
169 Add(StringText[LastLine + i])
170 else
171 Break;
172 LastLine := LastLine + i;
173 Add(' ');
174 Add(' ');
175 Add(StringOfChar('-', 74));
176 if LastLine >= StringText.Count - 1 then
177 Add(Trailer)
178 else
179 begin
180 ThisPage := ThisPage + 1;
181 Add('Page ' + IntToStr(ThisPage));
182 Add(PAGE_BREAK);
183 end;
184 end;
185 until LastLine >= StringText.Count - 1;
186 PrintWindowsReport(memPrintReport, PAGE_BREAK, Title, ErrMsg);
187 end;
188 finally
189 memPrintReport.Free;
190 AHeader.Free;
191 end;
192 end;
193 finally
194 frmFrame.CCOWBusy := False;
195 dlgPrintReport.Free;
196 end;
197end;
198
199procedure TfrmReportBox.memReportClick(Sender: TObject);
200begin
201 //Close;
202end;
203
204procedure TfrmReportBox.cmdPrintClick(Sender: TObject);
205begin
206 PrintStrings(Self, memReport.Lines, Self.Caption, 'End of report');
207 memReport.Invalidate;
208end;
209
210procedure TfrmReportBox.cmdCloseClick(Sender: TObject);
211begin
212 Close;
213end;
214
215procedure TfrmReportBox.FormClose(Sender: TObject; var Action: TCloseAction);
216begin
217 if(not (fsModal in FormState)) then
218 Action := caFree;
219end;
220
221procedure TfrmReportBox.FormCreate(Sender: TObject);
222begin
223 memReport.Color := ReadOnlyColor;
224end;
225
226end.
Note: See TracBrowser for help on using the repository browser.