1
2 {*****************************************}
3 { }
4 { FastReport v2.3 }
5 { Print DBGrid component }
6 { }
7 { FR_PGrid.pas: }
8 { Copyright (c) 1999 by }
9 { Butov Konstantin <kos@sp.iae.nsk.su> }
10 { }
11 { FastReport: }
12 { Copyright (c) 1998-99 by Tzyganenko A. }
13 { }
14 {*****************************************}
15
16 unit LR_PGrid;
17
18 interface
19
20 {$I LR_Vers.inc}
21
22 uses
23 SysUtils, Classes, Graphics, Controls, Forms, Dialogs, PropEdits,
24 DB, DBGrids, Printers, LR_DSet, LR_DBSet, LR_Class;
25
26 type
27
28 TFrPrintGrid = class;
29
30 TColumnInfo=record
31 Column: Integer;
32 ColumnWidth: Integer;
33 end;
34
35 TColumnInfoArr = Array of TColumnInfo;
36
37 TSetupColumnEvent=procedure(Sender:TFrPrintGrid; const Column: TColumn;
38 var PrintColumn:boolean; var ColumnWidth:Integer) of object;
39
40 TFinalSetupEvent=procedure(Sender:TFrPrintGrid; var FReport : TfrReport;
41 var FColumnsInfo : TColumnInfoArr ) of object;
42
43 { TfrPrintGrid }
44
45 TfrPrintGrid = class(TComponent)
46 private
47 FDBGrid : TCustomDBGrid;
48 FOnGetValue: TDetailEvent;
49 FOnSetUpColumn: TSetupColumnEvent;
50 FOnFinalSetup : TFinalSetupEvent;
51 FPrinterIndex : Integer;
52 FReport : TfrReport;
53 FReportDataSet : TfrDBDataSet;
54 FColumnDataSet : TfrUserDataSet;
55 FOrientation : TPrinterOrientation;
56 FFont, FTitleFont : TFont;
57 fShowProgress : Boolean;
58 fShowHdOnAllPage : boolean;
59 FCaption : String;
60 FShowCaption : Boolean;
61 FDataSet : TDataset;
62 FColumnsInfo : TColumnInfoArr;
63 FTemplate : string;
64
65 procedure OnEnterRect(Memo: TStringList; View: TfrView);
66 procedure OnPrintColumn(ColNo: Integer; var Width: Integer);
67 procedure SetDBGrid(const AValue: TCustomDBGrid);
68 procedure SetFont(AValue: TFont);
69 procedure SetTitleFont(AValue: TFont);
70 protected
71 { Protected declarations }
72 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
73 procedure SetupColumns;
FindBandnull74 function FindBand(APage: TFrPage; AType: TfrBandType): TFrBandView;
75 procedure ReplaceTemplate(APage:TFrPage; ABand: TFrBandView; ATemplate,AReplace:String);
76 procedure FindFreeSpace(APage: TfrPage; out XPos,YPos:Integer);
77 public
78 constructor Create(AOwner: TComponent); override;
79 destructor Destroy; override;
80
81 procedure PreviewReport;
82 published
83 property DBGrid: TCustomDBGrid read FDBGrid write SetDBGrid;
84 property Orientation: TPrinterOrientation read FOrientation write FOrientation default poPortrait;
85 property Font: TFont read FFont write SetFont;
86 property TitleFont : TFont read FTitleFont write SetTitleFont;
87 property Caption: String read FCaption write FCaption;
88 property Template: string read FTemplate write FTemplate;
89 property PrinterIndex: Integer read FPrinterIndex write FPrinterIndex;
90 property ShowCaption: Boolean read FShowCaption write FShowCaption;
91 property ShowHeaderOnAllPage : boolean read fShowHdOnAllPage write fShowHdOnAllPage default True;
92 property ShowProgress : Boolean read fShowProgress write fShowProgress default false;
93 property OnSetupColumn: TSetupColumnEvent read FOnSetUpColumn write FOnSetupColumn;
94 property OnGetValue: TDetailEvent read FOnGetValue write FOnGetValue;
95 property OnFinalSetup: TFinalSetupEvent read FOnFinalSetup write FOnFinalSetup;
96
97 end;
98
99
100 implementation
101
102 { TfrPrintGrid }
103
104 constructor TfrPrintGrid.Create(AOwner: TComponent);
105 begin
106 inherited Create(AOwner);
107 fShowHdOnAllPage:=True;
108 FFont := TFont.Create;
109 FFont.Name := 'default';
110 FFont.Charset := frCharset;
111 FFont.Size := 0;
112 FTitleFont := TFont.Create;
113 FTitleFont.Assign(FFont);
114 FTitleFont.Style := [fsBold];
115 FCaption := 'Grid';
116 FShowCaption := True;
117 fShowProgress:=False;
118 FPrinterIndex := -1;
119 end;
120
121 destructor TfrPrintGrid.Destroy;
122 begin
123 SetLength(FColumnsInfo, 0);
124 FFont.Free;
125 FTitleFont.Free;
126 inherited Destroy;
127 end;
128
129 procedure TfrPrintGrid.Notification(AComponent: TComponent; Operation: TOperation);
130 begin
131 inherited Notification(AComponent, Operation);
132 if (Operation = opRemove) and (AComponent = DBGrid) then
133 DBGrid := nil;
134 end;
135
136 procedure TfrPrintGrid.SetupColumns;
137 var
138 PrintColumn: Boolean;
139 i,j,ColumnWidth: Integer;
140 begin
141 SetLength(FColumnsInfo, 0);
142 for i:=0 to TDBGrid(DbGrid).Columns.Count-1 do begin
143
144 PrintColumn := TDBGrid(DbGrid).Columns[i].Visible;
145 ColumnWidth := TDBGrid(DbGrid).Columns[i].Width;
146
147 if Assigned(FOnSetupColumn) then
148 FOnSetupColumn(Self, TColumn(TDBGrid(DbGrid).Columns[i]), PrintColumn, ColumnWidth);
149
150 if PrintColumn then begin
151 j:=Length(FColumnsInfo);
152 SetLength(FColumnsInfo, j+1);
153 FColumnsInfo[j].Column := i;
154 FColumnsInfo[j].ColumnWidth := ColumnWidth;
155 end;
156
157 end;
158 end;
159
FindBandnull160 function TfrPrintGrid.FindBand(APage: TFrPage; AType:TfrBandType): TFrBandView;
161 var
162 i: Integer;
163 begin
164 for i:=0 to APage.Objects.Count-1 do begin
165 if not (TObject(APage.Objects[i]) is TFrBandView) then
166 continue;
167 Result := TFrBandView(APage.Objects[i]);
168 if Result.BandType=AType then
169 exit;
170 end;
171 result := nil;
172 end;
173
174 procedure TfrPrintGrid.ReplaceTemplate(APage: TFrPage; ABand: TFrBandView;
175 ATemplate, AReplace: String);
176 var
177 i: Integer;
178 Obj: TfrObject;
179 begin
180 for i:=0 to APage.Objects.Count-1 do begin
181 Obj := TfrObject(APage.Objects[i]);
182 if Obj is TfrMemoView then begin
183 if (Obj.y>=ABand.y) and (Obj.y<(ABand.Y+ABand.Dy)) then begin
184 // this memo is on ABand
185 TfrMemoView(Obj).Memo.Text := StringReplace(TfrMemoView(Obj).Memo.Text,
186 ATemplate, AReplace, [rfReplaceAll, rfIgnoreCase]);
187 end;
188 end;
189 end;
190 end;
191
192 procedure TfrPrintGrid.FindFreeSpace(APage: TfrPage; out XPos, YPos: Integer);
193 var
194 i: Integer;
195 Ydone,Xdone: boolean;
196 begin
197
198 YPos := 0;
199 XPos := 20;
200
201 YDone:= false;
202 XDone:= false;
203
204 for i:=0 to APage.Objects.Count-1 do begin
205 if not (TObject(APage.Objects[i]) is TFrBandView) then
206 continue;
207
208 with TfrBandView(APage.Objects[i]) do begin
209 if BandType in [btCrossHeader, btCrossData, btCrossFooter] then begin
210 if not XDone then begin
211 if x - XPos > 20 then
212 XDone := true
213 else
214 XPos := x + dx + 1;
215 end;
216 end else begin
217 if not YDone then begin
218 if y - YPos > 40 then
219 YDone := true
220 else
221 YPos := y + dy + 1;
222 end;
223 end;
224 end;
225
226 end;
227 end;
228
229 procedure TfrPrintGrid.SetDBGrid(const AValue: TCustomDBGrid);
230 begin
231 fDBGrid:=aValue;
232 if (csDesigning in ComponentState) and Assigned(fDBGrid) then
233 begin
234 fFont.Assign(fDBGrid.Font);
235 FTitleFont.Assign(TDBGrid(fDBGrid).TitleFont);
236 end;
237 end;
238
239 procedure TfrPrintGrid.SetFont(AValue: TFont);
240 begin
241 if FFont.IsEqual(AValue) then exit;
242 FFont.Assign(AValue);
243 end;
244
245 procedure TfrPrintGrid.SetTitleFont(AValue: TFont);
246 begin
247 if FTitleFont.IsEqual(AValue) then exit;
248 FTitleFont.Assign(AValue);
249 end;
250
251 procedure TfrPrintGrid.PreviewReport;
252 var
253 v: TfrView;
254 b,h: TfrBandView;
255 Page: TfrPage;
256 BM : TBookMark;
257 XPos,YPos: Integer;
258 SaveDesign:TfrReportDesigner;
259 begin
260 if (FDBGrid = nil) or (TDBGrid(DBGrid).Datasource = nil) or
261 (TDBGrid(DBGrid).Datasource.Dataset = nil) then Exit;
262
263 if (FTemplate<>'') and not FileExists(FTemplate) then
264 raise Exception.CreateFmt('Template file %s does not exists',[FTemplate]);
265
266 SaveDesign:=frDesigner;
267 frDesigner:=nil;
268
269 FReport := TfrReport.Create(Self);
270 if FTemplate<>'' then
271 FReport.LoadFromFile(FTemplate);
272
273 FDataSet := TDBGrid(DBGrid).Datasource.Dataset;
274
275 FReport.OnEnterRect :=@OnEnterRect;
276 FReport.OnPrintColumn:=@OnPrintColumn;
277 FReport.ShowProgress :=fShowProgress;
278 FReport.OnGetValue :=FOnGetValue;
279
280 FReportDataSet := TfrDBDataSet.Create(Self);
281 FReportDataSet.Name := 'frGridDBDataSet1';
282 FReportDataSet.DataSet := FDataSet;
283
284 SetupColumns;
285
286 FColumnDataSet := TfrUserDataSet.Create(Self);
287 FColumnDataSet.Name := 'frGridUserDataSet1';
288 FColumnDataSet.RangeEnd := reCount;
289 FColumnDataSet.RangeEndCount := Length(FColumnsInfo);
290
291 try
292 FReportDataSet.DataSource := TDBGrid(DBGrid).DataSource;
293 if FReport.Pages.Count=0 then
294 FReport.Pages.add;
295 Page := FReport.Pages[FReport.Pages.Count-1];
296
297 with Page do
298 ChangePaper(pgSize, Width, Height, FOrientation);
299
300 b := FindBand(Page, btReportTitle);
301 if b<>nil then begin
302 if FShowCaption then
303 ReplaceTemplate(Page, b, '<title>', FCaption);
304 end;
305
306 h := FindBand(Page, btPageHeader);
307 if h<>nil then begin
308 if FShowCaption then
309 ReplaceTemplate(Page, h, '<title>', FCaption);
310 end;
311
312 if FShowCaption and (b=nil) and (h=nil) then
313 begin
314 b := TfrBandView(frCreateObject(gtBand, '', Page));
315 b.SetBounds(10, 20, 1000, 25);
316 b.BandType := btReportTitle;
317 // Page.Objects.Add(b);
318 v := frCreateObject(gtMemo, '', Page);
319 v.SetBounds(20, 20, Page.PrnInfo.PgW - 40, 25);
320 TfrMemoView(v).Alignment:=taCenter;
321 TfrMemoView(v).Font.Assign(FTitleFont);
322 v.Memo.Add(FCaption);
323 // Page.Objects.Add(v);
324 end;
325
326 // if we have a template we need to be sure that bands on template
327 // do not overlap with bands we are about to add, we need exactly
328 // 40 pixels of free height space and 20 pixels width for cross band
329 FindFreeSpace(Page, XPos, YPos);
330
331 b := TfrBandView(frCreateObject(gtBand, '', Page));
332 b.BandType := btMasterHeader;
333 if self.fShowHdOnAllPage then
334 b.Flags:=b.Flags+flBandRepeatHeader;
335 b.SetBounds(XPos, YPos, 1000, 20);
336 b.Flags:=b.Flags or flStretched;
337 // Page.Objects.Add(b);
338
339 v := frCreateObject(gtMemo, '', Page);
340 v.SetBounds(XPos, YPos, 20, 20);
341 TfrMemoView(v).Alignment:=taCenter;
342 TfrMemoView(v).FillColor := clSilver;
343 TfrMemoView(v).Font.Assign(FTitleFont);
344 TfrMemoView(v).Frames:=frAllFrames;
345 TfrMemoView(v).Layout:=tlTop;
346 v.Memo.Add('[Header]');
347 // Page.Objects.Add(v);
348
349 YPos := YPos + 22;
350
351 b := TfrBandView(frCreateObject(gtBand, '', Page));
352 b.BandType := btMasterData;
353 b.Dataset := FReportDataSet.Name;
354 b.SetBounds(0, YPos, 1000, 18);
355 b.Flags:=b.Flags or flStretched;
356 // Page.Objects.Add(b);
357
358 b := TfrBandView(frCreateObject(gtBand, '', Page));
359 b.BandType := btCrossData;
360 b.Dataset := FColumnDataSet.Name;
361 b.SetBounds(XPos, 0, 20, 1000);
362 // Page.Objects.Add(b);
363
364 v := frCreateObject(gtMemo, '', Page);
365 v.SetBounds(XPos, YPos, 20, 18);
366 v.Memo.Add('[Cell]');
367 V.Flags:=V.Flags or flStretched;
368 TfrMemoView(v).Font.Assign(FFont);
369 TfrMemoView(v).Frames:=frAllFrames;
370 TfrMemoView(v).Layout:=tlTop;
371 // Page.Objects.Add(v);
372
373 FDataSet.DisableControls;
374 BM:=FDataSet.GetBookmark;
375 try
376 if (FPrinterIndex <> -1) then
377 begin
378 FReport.ChangePrinter(Printer.PrinterIndex, FPrinterIndex);
379 FReport.PrepareReport;
380 end;
381
382 if Assigned( OnFinalSetup ) then
383 OnFinalSetup( Self, FReport, FColumnsInfo );
384
385 FReport.ShowReport;
386 finally
387 FDataSet.GotoBookmark(BM);
388 FDataSet.FreeBookmark(BM);
389 FDataSet.EnableControls;
390 end;
391 finally
392 FReport.Free;
393 FReportDataSet.Free;
394 FColumnDataSet.Free;
395 end;
396 // ToDo: invert this assignment. Now SaveDesign is only assigned but not used.
397 SaveDesign:=frDesigner;
398 end;
399
400 procedure TfrPrintGrid.OnEnterRect(Memo: TStringList; View: TfrView);
401 var
402 C: TColumn;
403 i: Integer;
404 begin
405 i := FColumnDataset.RecNo;
406
407 if (i<0) or (i>Length(FColumnsInfo)-1) then
408 exit;
409
410 C := TColumn(TDBGrid(DbGrid).Columns[FColumnsInfo[i].Column]);
411 if (C<>nil)and(Memo.Count>0) then
412 begin
413 if (Memo[0]='[Cell]') and (C.Field<>nil) then
414 begin
415 Memo[0] := C.Field.DisplayText;
416 View.dx := FColumnsInfo[i].ColumnWidth;
417 TfrMemoView(View).Alignment:=C.Alignment;
418 end else
419 if Memo[0]='[Header]' then
420 begin
421 Memo[0] := C.Title.Caption;
422 View.dx := FColumnsInfo[i].ColumnWidth;
423 end;
424 end;
425 end;
426
427 procedure TfrPrintGrid.OnPrintColumn(ColNo: Integer; var Width: Integer);
428 begin
429 if (ColNo<1) or (ColNo>Length(FColumnsInfo)) then
430 exit;
431 Width := FColumnsInfo[ColNo-1].ColumnWidth;
432 end;
433
434 initialization
435 RegisterPropertyEditor(TypeInfo(AnsiString),
436 TFrPrintGrid,'Template',TFileNamePropertyEditor);
437 end.
438