/Source/FR_PGRID.PAS

  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
 16unit FR_PGrid;
 17
 18interface
 19
 20{$I FR.inc}
 21
 22uses
 23  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 24  DB, DBGrids, Printers, FR_DSet, FR_DBSet, FR_Class;
 25
 26type
 27  TfrPrintGrid = class(TComponent)
 28  private
 29    FDBGrid: TDBGrid;
 30    FReport: TfrReport;
 31    FReportDataSet: TfrDBDataSet;
 32    FColumnDataSet: TfrUserDataSet;
 33    FOrientation: TPrinterOrientation;
 34    FFont, FTitleFont: TFont;
 35    FCaption: String;
 36    FShowCaption: Boolean;
 37    FWidth: Integer;
 38    FDataSet: TDataset;
 39    procedure OnEnterRect(Memo: TStringList; View: TfrView);
 40    procedure OnPrintColumn(ColNo: Integer; var Width: Integer);
 41    function RealColumnIndex(Index: Integer; UseDD: Boolean): Integer;
 42  protected
 43    { Protected declarations }
 44    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 45  public
 46    constructor Create(AOwner: TComponent); override;
 47    destructor Destroy; override;
 48    procedure PreviewReport;
 49  published
 50    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
 51    property Orientation: TPrinterOrientation read FOrientation write FOrientation default poPortrait;
 52    property Font: TFont read FFont write FFont;
 53    property Caption: String read FCaption write FCaption;
 54    property ShowCaption: Boolean read FShowCaption write FShowCaption;
 55 end;
 56
 57
 58procedure Register;
 59
 60implementation
 61
 62type
 63  THackDBGrid = class(TDBGrid)
 64  end;
 65
 66{ TfrPrintGrid }
 67
 68constructor TfrPrintGrid.Create(AOwner: TComponent);
 69begin
 70  inherited Create(AOwner);
 71  FFont := TFont.Create;
 72  FFont.Name := 'Arial';
 73{$IFNDEF Delphi2}
 74  FFont.Charset := frCharset;
 75{$ENDIF}
 76  FFont.Size := 10;
 77  FTitleFont := TFont.Create;
 78  FTitleFont.Assign(FFont);
 79  FTitleFont.Style := [fsBold];
 80  FCaption := 'Grid';
 81  FShowCaption := True;
 82end;
 83
 84destructor TfrPrintGrid.Destroy;
 85begin
 86  FFont.Free;
 87  FTitleFont.Free;
 88  inherited Destroy;
 89end;
 90
 91procedure TfrPrintGrid.Notification(AComponent: TComponent; Operation: TOperation);
 92begin
 93  inherited Notification(AComponent, Operation);
 94  if (Operation = opRemove) and (AComponent = DBGrid) then
 95    DBGrid := nil;
 96end;
 97
 98function TfrPrintGrid.RealColumnIndex(Index: Integer; UseDD: Boolean): Integer;
 99var
100  Y, I, DD: Integer;
101begin
102  Result := 0;
103  if (dgIndicator in DBGrid.Options) and UseDD then
104    DD := 1 else
105    DD := 0;
106  Y := -1;
107  for I := 0 to FDataSet.FieldCount - 1 do
108    if FDataSet.Fields[I].Visible then
109    begin
110      Inc(Y);
111      if Y = Index then
112      begin
113        Result := I + DD;
114        break;
115      end;
116    end;
117end;
118
119procedure TfrPrintGrid.PreviewReport;
120var
121  v: TfrView;
122  b: TfrBandView;
123  Page: TfrPage;
124begin
125  if (FDBGrid = nil) or (DBGrid.Datasource = nil) or
126     (DBGrid.Datasource.Dataset = nil) then Exit;
127
128  FDataSet := DBGrid.Datasource.Dataset;
129
130  FReport := TfrReport.Create(Self);
131  FReport.OnEnterRect := OnEnterRect;
132  FReport.OnPrintColumn := OnPrintColumn;
133
134  FReportDataSet := TfrDBDataSet.Create(Self);
135  FReportDataSet.Name := 'frGridDBDataSet1';
136  FReportDataSet.DataSet := FDataSet;
137
138  FColumnDataSet := TfrUserDataSet.Create(Self);
139  FColumnDataSet.Name := 'frGridUserDataSet1';
140  FColumnDataSet.RangeEnd := reCount;
141  FColumnDataSet.RangeEndCount := FDataSet.FieldCount;
142
143  try
144    FReportDataSet.DataSource := DBGrid.DataSource;
145    FReport.Pages.Add;
146    Page := FReport.Pages[0];
147    with Page do
148      ChangePaper(pgSize, pgWidth, pgHeight, FOrientation);
149
150    if FShowCaption then
151    begin
152      b := TfrBandView(frCreateObject(gtBand, ''));
153      b.SetBounds(10, 20, 1000, 25);
154      b.BandType := btReportTitle;
155      Page.Objects.Add(b);
156      v := frCreateObject(gtMemo, '');
157      v.SetBounds(20, 20, Page.PrnInfo.PgW - 40, 25);
158      TfrMemoView(v).Adjust:= frtaCenter;
159      TfrMemoView(v).Font := FTitleFont;
160      v.Memo.Add(FCaption);
161      Page.Objects.Add(v);
162    end;
163
164    b := TfrBandView(frCreateObject(gtBand, ''));
165    b.BandType := btMasterHeader;
166    b.SetBounds(20, 60, 1000, 20);
167    Page.Objects.Add(b);
168
169    v := frCreateObject(gtMemo, '');
170    v.SetBounds(20, 60, 20, 20);
171    TfrMemoView(v).Adjust := frtaCenter;
172    TfrMemoView(v).FillColor := clGray;
173    TfrMemoView(v).Font := FTitleFont;
174    TfrMemoView(v).FrameTyp := 15;
175    v.Memo.Add('[Header]');
176    Page.Objects.Add(v);
177
178    b := TfrBandView(frCreateObject(gtBand, ''));
179    b.BandType := btMasterData;
180    b.Dataset := FReportDataSet.Name;
181    b.SetBounds(0, 100, 1000, 18);
182    Page.Objects.Add(b);
183
184    b := TfrBandView(frCreateObject(gtBand, ''));
185    b.BandType := btCrossData;
186    b.Dataset := FColumnDataSet.Name;
187    b.SetBounds(20, 0, 20, 1000);
188    Page.Objects.Add(b);
189
190    v := frCreateObject(gtMemo, '');
191    v.SetBounds(20, 100, 20, 18);
192    v.Memo.Add('[Cell]');
193    TfrMemoView(v).FrameTyp := 15;
194    Page.Objects.Add(v);
195
196    FReport.ShowReport;
197  finally
198    FReport.Free;
199    FReportDataSet.Free;
200    FColumnDataSet.Free;
201  end;
202end;
203
204procedure TfrPrintGrid.OnEnterRect(Memo: TStringList; View: TfrView);
205begin
206  if Memo[0] = '[Cell]' then
207  begin
208    Memo[0] := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo, False)].AsString;
209    View.dx := FWidth;
210    case FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo, False)].Alignment of
211      taLeftJustify : TfrMemoView(View).Adjust := frtaLeft;
212      taRightJustify: TfrMemoView(View).Adjust := frtaRight;
213      taCenter      : TfrMemoView(View).Adjust := frtaCenter;
214    end;
215  end;
216  if Memo[0] = '[Header]' then
217  begin
218    Memo[0] := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo, False)].FieldName;
219    View.dx := FWidth;
220  end;
221end;
222
223procedure TfrPrintGrid.OnPrintColumn(ColNo: Integer; var Width: Integer);
224begin
225  Width := THackDBGrid(DBGrid).ColWidths[RealColumnIndex(ColNo - 1, True)];
226  FWidth := Width;
227end;
228
229
230procedure Register;
231begin
232  RegisterComponents('ButSoft', [TfrPrintGrid]);
233end;
234
235end.