home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_PTabl.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-08  |  25KB  |  899 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {            Print table component         }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_PTabl;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   Types, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   DB, QDBGrids, FR_DSet, FR_DBSet, QPrinters
  20. {$IFDEF IBO}
  21. , IB_Components
  22. {$ENDIF}
  23. , FR_Class, FR_View;
  24.  
  25. type
  26.   TfrPrintColumnEvent = procedure(ColumnNo: Integer; var Width: Integer) of object;
  27.  
  28.   TfrDataSection = (frOther, frHeader, frData, frFooter);
  29. {$IFDEF IBO}
  30.   TfrPrintDataEvent = procedure(Field: TIB_Column; Memo:TStringList;
  31.     View: TfrView; Section: TfrDataSection) of object;
  32. {$ELSE}
  33.   TfrPrintDataEvent = procedure(Field: TField; Memo:TStringList;
  34.     View: TfrView; Section: TfrDataSection) of object;
  35. {$ENDIF}
  36.  
  37.   TfrPrintOption = (frpoHeader, frpoHeaderOnEveryPage, frpoFooter);
  38.   TfrPrintOptions = set of TfrPrintOption;
  39.  
  40.   TfrFrameLine = (frLeft, frTop, frRight, frBottom);
  41.   TfrFrameLines = set of TfrFrameLine;
  42.  
  43.   TfrWidthsArray = Array[0..255] of Word;
  44.   TfrCustomWidthsEvent = procedure(var Widths: TfrWidthsArray; DataColumns, PageActiveWidth: integer) of object;
  45.  
  46.   TfrPageMargins = class(TPersistent)
  47.   private
  48.     FLeft: Integer;
  49.     FTop: Integer;
  50.     FRight: Integer;
  51.     FBottom: Integer;
  52.   public
  53.     constructor Create; virtual;
  54.     procedure Assign(Source: TPersistent); override;
  55.   published
  56.     property Left: Integer read FLeft write FLeft;
  57.     property Top: Integer read FTop write FTop;
  58.     property Right: Integer read FRight write FRight;
  59.     property Bottom: Integer read FBottom write FBottom;
  60.   end;
  61.  
  62.   TfrSectionParams = class(TPersistent)
  63.   private
  64.     FFont: TFont;
  65.     FColor: TColor;
  66.     FFrame: TfrFrameLines;
  67.     FFrameWidth: Integer;
  68.     procedure SetFont(Value: TFont);
  69.   public
  70.     constructor Create; virtual;
  71.     destructor Destroy; override;
  72.     procedure Assign(Source: TPersistent); override;
  73.     function GetFrameTyp: Integer;
  74.   published
  75.     property Font: TFont read FFont write SetFont;
  76.     property Color: TColor read FColor write FColor;
  77.     property Frame: TfrFrameLines read FFrame write FFrame;
  78.     property FrameWidth: Integer read FFrameWidth write FFrameWidth;
  79.   end;
  80.  
  81.   TfrAdvSectionParams = class(TfrSectionParams)
  82.   private
  83.     FAlign: TAlignment;
  84.     FText: String;
  85.   public
  86.     constructor Create; override;
  87.     procedure Assign(Source: TPersistent); override;
  88.     function GetAlign: Integer;
  89.   published
  90.     property Align: TAlignment read FAlign write FAlign default taCenter;
  91.     property Text: String read FText write FText;
  92.   end;
  93.  
  94.   TfrCustomPrintDataSet = class(TComponent)
  95.   private
  96.     FWidths: TfrWidthsArray;
  97.     FCustomizeWidths: TfrCustomWidthsEvent;
  98.     FpgSize: Integer;
  99.     FpgWidth: Integer;
  100.     FpgHeight: Integer;
  101.     FPageMargins: TfrPageMargins;
  102.     FOrientation: TPrinterOrientation;
  103.     FTitle, FPageHeader, FPageFooter: TfrAdvSectionParams;
  104.     FHeader, FBody: TfrSectionParams;
  105.     FWidth: Integer;
  106.     FReport: TfrReport;
  107.     FPreview: TfrPreview;
  108.     FReportDataSet: TfrDBDataSet;
  109.     FColumnDataSet: TfrUserDataSet;
  110.     FOnPrintColumn: TfrPrintColumnEvent;
  111.     FOnPrintData: TfrPrintDataEvent;
  112.     FFooter: TfrSectionParams;
  113.     FPrintOptions: TfrPrintOptions;
  114.     function GetFieldCount: Integer; virtual;
  115.     procedure OnEnterRect(Memo: TStringList; View: TfrView); virtual;
  116.     procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); virtual;
  117.     function RealColumnIndex(Index: Integer): Integer;
  118.     procedure SetPageMargins(Value: TfrPageMargins);
  119.     procedure SetTitle(Value: TfrAdvSectionParams);
  120.     procedure SetPageHeader(Value: TfrAdvSectionParams);
  121.     procedure SetPageFooter(Value: TfrAdvSectionParams);
  122.     procedure SetHeader(Value: TfrSectionParams);
  123.     procedure SetBody(Value: TfrSectionParams);
  124.     procedure SetFooter(const Value: TfrSectionParams);
  125.   protected
  126.     { Protected declarations }
  127.   {$IFDEF IBO}
  128.     FDataSet: TIB_Dataset;
  129.   {$ELSE}
  130.     FDataSet: TDataset;
  131.   {$ENDIF}
  132.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  133.   public
  134.     constructor Create(AOwner: TComponent); override;
  135.     destructor Destroy; override;
  136.     procedure CreateDS; virtual;
  137.  
  138.     procedure BuildReport;
  139.     procedure ShowReport;
  140.  
  141.     property PageSize: Integer read FpgSize write FpgSize;
  142.     property PageWidth: Integer read FpgWidth write FpgWidth;
  143.     property PageHeight: Integer read FpgHeight write FpgHeight;
  144.     property PageMargins: TfrPageMargins read FPageMargins write SetPageMargins;
  145.     property Orientation: TPrinterOrientation read FOrientation write FOrientation default poPortrait;
  146.     property Title: TfrAdvSectionParams read FTitle write SetTitle;
  147.     property PageHeader: TfrAdvSectionParams read FPageHeader write SetPageHeader;
  148.     property PageFooter: TfrAdvSectionParams read FPageFooter write SetPageFooter;
  149.     property Header: TfrSectionParams read FHeader write SetHeader;
  150.     property Footer: TfrSectionParams read FFooter write SetFooter;
  151.     property Body: TfrSectionParams read FBody write SetBody;
  152.     property Preview: TfrPreview read FPreview write FPreview;
  153.     property Report: TfrReport read FReport;
  154.     property OnPrintColumn: TfrPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;
  155.     property OnPrintData: TfrPrintDataEvent read FOnPrintData write FOnPrintData;
  156.     property PrintOptions: TfrPrintOptions read FPrintOptions write FPrintOptions;
  157.     property OnCustomizeWidths: TfrCustomWidthsEvent read FCustomizeWidths write FCustomizeWidths;
  158.   end;
  159.  
  160.   TfrPrintTable = class(TfrCustomPrintDataSet)
  161.   private
  162.     FAutoWidth: Boolean;
  163.     procedure OnEnterRect(Memo: TStringList; View: TfrView); override;
  164.     procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); override;
  165.   protected
  166.     { Protected declarations }
  167.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  168.   public
  169.     constructor Create(AOwner: TComponent); override;
  170.     procedure CreateDS; override;
  171.   published
  172.     property AutoWidth: Boolean read FAutoWidth write FAutoWidth default True;
  173.   {$IFDEF IBO}
  174.     property DataSet: TIB_DataSet read FDataSet write FDataSet;
  175.   {$ELSE}
  176.     property DataSet: TDataSet read FDataSet write FDataSet;
  177.   {$ENDIF}
  178.     property PageSize;
  179.     property PageWidth;
  180.     property PageHeight;
  181.     property PageMargins;
  182.     property Orientation;
  183.     property Title;
  184.     property PageHeader;
  185.     property PageFooter;
  186.     property Header;
  187.     property Footer;
  188.     property Body;
  189.     property PrintOptions;
  190.     property OnPrintColumn;
  191.     property OnPrintData;
  192.     property OnCustomizeWidths;
  193.   end;
  194.  
  195. {$IFNDEF IBO}
  196.   TfrPrintGrid = class(TfrCustomPrintDataSet)
  197.   private
  198.     FDBGrid: TDBGrid;
  199.     function GetFieldCount: Integer; override;
  200.     function RealGridIndex(Index: Integer): Integer;
  201.     procedure OnEnterRect(Memo: TStringList; View: TfrView); override;
  202.     procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); override;
  203.   protected
  204.     { Protected declarations }
  205.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  206.   public
  207.     procedure CreateDS; override;
  208.   published
  209.     property DBGrid: TDBGrid read FDBGrid write FDBGrid;
  210.     property PageSize;
  211.     property PageWidth;
  212.     property PageHeight;
  213.     property PageMargins;
  214.     property Orientation;
  215.     property Title;
  216.     property PageHeader;
  217.     property PageFooter;
  218.     property Header;
  219.     property Body;
  220.     property OnPrintColumn;
  221.  end;
  222. {$ENDIF}
  223.  
  224.  
  225. implementation
  226.  
  227.  
  228. { TfrSectionParams }
  229.  
  230. constructor TfrSectionParams.Create;
  231. begin
  232.   inherited Create;
  233.   FFont := TFont.Create;
  234.   FFont.Name := 'Arial';
  235.   FFont.Charset := TFontCharset(frCharset);
  236.   FFont.Size := 10;
  237.   FColor := clWhite;
  238.   FFrame := [frLeft, frTop, frRight, frBottom];
  239.   FFrameWidth := 1;
  240. end;
  241.  
  242. destructor TfrSectionParams.Destroy;
  243. begin
  244.   FFont.Free;
  245.   inherited Destroy;
  246. end;
  247.  
  248. procedure TfrSectionParams.Assign(Source: TPersistent);
  249. begin
  250.   inherited Assign(Source);
  251.   FFont.Assign(TfrSectionParams(Source).Font);
  252.   FColor := TfrSectionParams(Source).Color;
  253.   FFrame := TfrSectionParams(Source).Frame;
  254. end;
  255.  
  256. procedure TfrSectionParams.SetFont(Value: TFont);
  257. begin
  258.   FFont.Assign(Value);
  259. end;
  260.  
  261. function TfrSectionParams.GetFrameTyp: Integer;
  262. begin
  263.   Result := 0;
  264.   if frLeft in FFrame then
  265.     Result := frftLeft;
  266.   if frRight in FFrame then
  267.     Result := Result + frftRight;
  268.   if frTop in FFrame then
  269.     Result := Result + frftTop;
  270.   if frBottom in FFrame then
  271.     Result := Result + frftBottom;
  272. end;
  273.  
  274.  
  275. { TfrAdvSectionParams }
  276.  
  277. constructor TfrAdvSectionParams.Create;
  278. begin
  279.   inherited Create;
  280.   FAlign := taCenter;
  281.   FFrame := [];
  282. end;
  283.  
  284. procedure TfrAdvSectionParams.Assign(Source: TPersistent);
  285. begin
  286.   inherited Assign(Source);
  287.   FAlign := TfrAdvSectionParams(Source).Align;
  288.   FText := TfrAdvSectionParams(Source).Text;
  289. end;
  290.  
  291. function TfrAdvSectionParams.GetAlign: Integer;
  292. begin
  293.   Result := 0;
  294.   if FAlign = taLeftJustify then
  295.     Result := frtaLeft
  296.   else if FAlign = taRightJustify then
  297.     Result := frtaRight
  298.   else if FAlign = taCenter then
  299.     Result := frtaCenter
  300. end;
  301.  
  302.  
  303. { TfrPageMargins }
  304.  
  305. constructor TfrPageMargins.Create;
  306. begin
  307.   inherited Create;
  308.   FLeft   := 0;
  309.   FTop    := 0;
  310.   FRight  := 0;
  311.   FBottom := 0;
  312. end;
  313.  
  314. procedure TfrPageMargins.Assign(Source: TPersistent);
  315. begin
  316.   inherited Assign(Source);
  317.   FLeft   := TfrPageMargins(Source).Left;
  318.   FTop    := TfrPageMargins(Source).Top;
  319.   FRight  := TfrPageMargins(Source).Right;
  320.   FBottom := TfrPageMargins(Source).Bottom;
  321. end;
  322.  
  323.  
  324. { TfrCustomPrintDataSet }
  325.  
  326. constructor TfrCustomPrintDataSet.Create(AOwner: TComponent);
  327. begin
  328.   inherited Create(AOwner);
  329.   FPageMargins := TfrPageMargins.Create;
  330.   FpgSize := 9;
  331.   FTitle := TfrAdvSectionParams.Create;
  332.   FTitle.Font.Style := [fsBold];
  333.   FTitle.Font.Size := 12;
  334.  
  335.   FPageHeader := TfrAdvSectionParams.Create;
  336.  
  337.   FPageFooter := TfrAdvSectionParams.Create;
  338.  
  339.   FHeader := TfrSectionParams.Create;
  340.   FHeader.Font.Style := [fsBold];
  341.   FHeader.Font.Color := clWhite;
  342.   FHeader.Color := clNavy;
  343.  
  344.   FFooter := TfrSectionParams.Create;
  345.   FFooter.Font.Style := [fsItalic];
  346.   FFooter.Color := clSilver;
  347.  
  348.   FBody := TfrSectionParams.Create;
  349.   FReport := TfrReport.Create(Self);
  350.   FReport.PreviewButtons := [pbZoom, pbSave, pbPrint, pbFind, pbHelp, pbExit, pbPageSetup];
  351.  
  352.   FReportDataSet := TfrDBDataSet.Create(Self);
  353.   FReportDataSet.Name := 'frGridDBDataSet1';
  354.  
  355.   FColumnDataSet := TfrUserDataSet.Create(Self);
  356.   FColumnDataSet.Name := 'frGridUserDataSet1';
  357.   FColumnDataSet.RangeEnd := reCount;
  358.  
  359.   FPrintOptions:=[frpoHeader, frpoHeaderOnEveryPage];
  360. end;
  361.  
  362. destructor TfrCustomPrintDataSet.Destroy;
  363. begin
  364.   FReportDataSet.Free;
  365.   FColumnDataSet.Free;
  366.   FReport.Free;
  367.   FTitle.Free;
  368.   FPageHeader.Free;
  369.   FPageFooter.Free;
  370.   FHeader.Free;
  371.   FFooter.Free;
  372.   FBody.Free;
  373.   FPageMargins.Free;
  374.   inherited Destroy;
  375. end;
  376.  
  377. procedure TfrCustomPrintDataSet.Notification(AComponent: TComponent; Operation: TOperation);
  378. begin
  379.   inherited Notification(AComponent, Operation);
  380.   if (Operation = opRemove) and (AComponent = FPreview) then
  381.     FPreview := nil;
  382. end;
  383.  
  384. function TfrCustomPrintDataSet.RealColumnIndex(Index: Integer): Integer;
  385. var
  386.   Y, I: Integer;
  387. begin
  388.   Result := 0;
  389.   Y := -1;
  390.   for I := 0 to FDataSet.FieldCount - 1 do
  391.     if FDataSet.Fields[I].Visible then
  392.     begin
  393.       Inc(Y);
  394.       if Y = Index then
  395.       begin
  396.         Result := I;
  397.         break;
  398.       end;
  399.     end;
  400. end;
  401.  
  402. procedure TfrCustomPrintDataSet.SetPageMargins(Value: TfrPageMargins);
  403. begin
  404.   FPageMargins.Assign(Value);
  405. end;
  406.  
  407. procedure TfrCustomPrintDataSet.SetTitle(Value: TfrAdvSectionParams);
  408. begin
  409.   FTitle.Assign(Value);
  410. end;
  411.  
  412. procedure TfrCustomPrintDataSet.SetPageHeader(Value: TfrAdvSectionParams);
  413. begin
  414.   FPageHeader.Assign(Value);
  415. end;
  416.  
  417. procedure TfrCustomPrintDataSet.SetPageFooter(Value: TfrAdvSectionParams);
  418. begin
  419.   FPageFooter.Assign(Value);
  420. end;
  421.  
  422. procedure TfrCustomPrintDataSet.SetHeader(Value: TfrSectionParams);
  423. begin
  424.   FHeader.Assign(Value);
  425. end;
  426.  
  427. procedure TfrCustomPrintDataSet.SetBody(Value: TfrSectionParams);
  428. begin
  429.   FBody.Assign(Value);
  430. end;
  431.  
  432. procedure TfrCustomPrintDataSet.CreateDS;
  433. begin
  434. end;
  435.  
  436. function TfrCustomPrintDataSet.GetFieldCount: Integer;
  437. var
  438.   i: Integer;
  439.   b: Boolean;
  440. begin
  441.   Result := FDataSet.FieldCount;
  442.   b := True;
  443.   for i := 0 to FDataSet.FieldCount - 1 do
  444.     if (FDataSet.Fields[i] <> nil) and FDataSet.Fields[i].Visible then
  445.     begin
  446.       if b then
  447.       begin
  448.         b := False;
  449.         Result := 0;
  450.       end;
  451.       Inc(Result);
  452.     end;
  453. end;
  454.  
  455. procedure TfrCustomPrintDataSet.BuildReport;
  456. var
  457.   v: TfrView;
  458.   b: TfrBandView;
  459.   Page: TfrPage;
  460.   LeftMargin: Integer;
  461. begin
  462.   CreateDS;
  463.   if FDataSet = nil then Exit;
  464.  
  465.   FReport.OnBeforePrint := OnEnterRect;
  466.   FReport.OnPrintColumn := OnPrintColumn_;
  467.   FReport.Preview := FPreview;
  468.  
  469.   FReportDataSet.DataSet := FDataSet;
  470.   FColumnDataSet.RangeEndCount := GetFieldCount;
  471.  
  472.   FReport.Clear;
  473.   FReport.Pages.Add;
  474.   Page := FReport.Pages[0];
  475.   with Page do
  476.   begin
  477.     pgMargins.Left   := Round(FPageMargins.Left   * 18 / 5);
  478.     pgMargins.Top    := Round(FPageMargins.Top    * 18 / 5);
  479.     pgMargins.Right  := Round(FPageMargins.Right  * 18 / 5);
  480.     pgMargins.Bottom := Round(FPageMargins.Bottom * 18 / 5);
  481.     ChangePaper(FpgSize, FpgWidth * 10, FpgHeight * 10, -1, FOrientation);
  482.   end;
  483.  
  484.   LeftMargin := Page.PrnInfo.Ofx;
  485.   if Page.pgMargins.Left <> 0 then
  486.     LeftMargin := Page.pgMargins.Left;
  487.  
  488.   if Assigned(FCustomizeWidths) then FCustomizeWidths(FWidths, FColumnDataSet.RangeEndCount, Page.RightMargin-Page.LeftMargin);
  489.  
  490. // Title
  491.   if FTitle.Text <> '' then
  492.   begin
  493.     b := TfrBandView(frCreateObject(gtBand, ''));
  494.     b.SetBounds(0, 20, 1000, 30);
  495.     b.Flags := b.Flags or flStretched;
  496.     b.BandType := btReportTitle;
  497.     Page.Objects.Add(b);
  498.     v := frCreateObject(gtMemo, '');
  499.     v.SetBounds(0, 20, 20, 20);
  500.     v.BandAlign := baWidth;
  501.     TfrMemoView(v).Alignment:= FTitle.GetAlign + frtaMiddle;
  502.     TfrMemoView(v).Font := FTitle.Font;
  503.     v.FrameTyp := FTitle.GetFrameTyp;
  504.     v.FrameWidth := FTitle.FrameWidth;
  505.     v.FillColor := FTitle.Color;
  506.     v.Memo.Add(FTitle.Text);
  507.     Page.Objects.Add(v);
  508.   end;
  509.  
  510. // Header
  511.   if frpoHeader in FPrintOptions then
  512.   begin
  513.     b := TfrBandView(frCreateObject(gtBand, ''));
  514.     b.BandType := btMasterHeader;
  515.     b.SetBounds(0, 60, 1000, 30);
  516.     b.Flags := b.Flags or flStretched;
  517.     if frpoHeaderOnEveryPage in FPrintOptions then
  518.       b.Flags := b.Flags or flBandRepeatHeader;
  519.     Page.Objects.Add(b);
  520.  
  521.     v := frCreateObject(gtMemo, '');
  522.     v.SetBounds(LeftMargin, 60, 20, 30);
  523.     TfrMemoView(v).Alignment := frtaCenter + frtaMiddle;
  524.     TfrMemoView(v).Font := FHeader.Font;
  525.     v.FillColor := FHeader.Color;
  526.     v.FrameTyp := FHeader.GetFrameTyp;
  527.     v.FrameWidth := FHeader.FrameWidth;
  528.     v.Flags := v.Flags or flWordWrap or flStretched;
  529.     v.Memo.Add('[Header]');
  530.     Page.Objects.Add(v);
  531.   end;
  532.  
  533. // Body
  534.   b := TfrBandView(frCreateObject(gtBand, ''));
  535.   b.BandType := btMasterData;
  536.   b.Dataset := FReportDataSet.Name;
  537.   b.SetBounds(0, 100, 1000, 18);
  538.   b.Flags := b.Flags or flStretched;
  539.   Page.Objects.Add(b);
  540.  
  541.   b := TfrBandView(frCreateObject(gtBand, ''));
  542.   b.BandType := btCrossData;
  543.   b.Dataset := FColumnDataSet.Name;
  544.   b.SetBounds(LeftMargin, 0, 20, 1000);
  545.   Page.Objects.Add(b);
  546.  
  547.   v := frCreateObject(gtMemo, '');
  548.   v.SetBounds(LeftMargin, 100, 20, 18);
  549.   TfrMemoView(v).Font := FBody.Font;
  550.   v.FillColor := FBody.Color;
  551.   v.FrameTyp := FBody.GetFrameTyp;
  552.   v.FrameWidth := FBody.FrameWidth;
  553.   TfrMemoView(v).GapX := 3;
  554.   v.Flags := v.Flags or flWordWrap or flStretched;
  555.   v.Memo.Add('[Cell]');
  556.   Page.Objects.Add(v);
  557.  
  558.  
  559. // Footer
  560.   if frpoFooter in FPrintOptions then
  561.   begin
  562.     b:=TfrBandView(frCreateObject(gtBand, ''));
  563.     b.BandType := btMasterFooter;
  564.     b.SetBounds(0, 140, 1000, 30);
  565.     Page.Objects.Add(b);
  566.  
  567.     v := frCreateObject(gtMemo, '');
  568.     v.SetBounds(LeftMargin, 140, 20, 30);
  569.     TfrMemoView(v).Alignment := frtaCenter + frtaMiddle;
  570.     TfrMemoView(v).Font := FFooter.Font;
  571.     v.FillColor := FFooter.Color;
  572.     v.FrameTyp := FFooter.GetFrameTyp;
  573.     v.FrameWidth := FFooter.FrameWidth;
  574.     v.Flags := v.Flags or flWordWrap or flStretched;
  575.     v.Memo.Add('[Footer]');
  576.     Page.Objects.Add(v);
  577.   end;
  578.  
  579. // Page header
  580.   if FPageHeader.Text <> '' then
  581.   begin
  582.     b := TfrBandView(frCreateObject(gtBand, ''));
  583.     b.BandType := btPageHeader;
  584.     b.SetBounds(0, 160, 1000, 30);
  585.     Page.Objects.Add(b);
  586.  
  587.     v := frCreateObject(gtMemo, '');
  588.     v.SetBounds(0, 160, 20, 20);
  589.     v.BandAlign := baWidth;
  590.     TfrMemoView(v).Alignment := FPageHeader.GetAlign;
  591.     TfrMemoView(v).Font := FPageHeader.Font;
  592.     v.FillColor := FPageHeader.Color;
  593.     v.FrameTyp := FPageHeader.GetFrameTyp;
  594.     v.FrameWidth := FPageHeader.FrameWidth;
  595.     v.Memo.Add(FPageHeader.Text);
  596.     Page.Objects.Add(v);
  597.   end;
  598.  
  599. // Page footer
  600.   if FPageFooter.Text <> '' then
  601.   begin
  602.     b := TfrBandView(frCreateObject(gtBand, ''));
  603.     b.BandType := btPageFooter;
  604.     b.SetBounds(0, 260, 1000, 30);
  605.     Page.Objects.Add(b);
  606.  
  607.     v := frCreateObject(gtMemo, '');
  608.     v.SetBounds(0, 270, 20, 20);
  609.     v.BandAlign := baWidth;
  610.     TfrMemoView(v).Alignment := FPageFooter.GetAlign;
  611.     TfrMemoView(v).Font := FPageFooter.Font;
  612.     v.FillColor := FPageFooter.Color;
  613.     v.FrameTyp := FPageFooter.GetFrameTyp;
  614.     v.FrameWidth := FPageFooter.FrameWidth;
  615.     v.Memo.Add(FPageFooter.Text);
  616.     Page.Objects.Add(v);
  617.   end;
  618. end;
  619.  
  620. procedure TfrCustomPrintDataSet.ShowReport;
  621. var
  622.   cd: Boolean;
  623. begin
  624. {$IFDEF IBO}
  625.   cd := True;
  626. {$ELSE}
  627.   cd := FDataSet.ControlsDisabled;
  628. {$ENDIF}
  629.   try
  630.     FDataSet.DisableControls;
  631.     BuildReport;
  632.     FReport.ShowReport;
  633.   finally
  634.     if not cd then FDataSet.EnableControls;
  635.   end;
  636. end;
  637.  
  638. procedure TfrCustomPrintDataSet.OnEnterRect(Memo: TStringList; View: TfrView);
  639. begin
  640. // empty method
  641. end;
  642.  
  643. procedure TfrCustomPrintDataSet.OnPrintColumn_(ColNo: Integer; var Width: Integer);
  644. begin
  645. //--  Width := FWidths[ColNo]; - do not set here. It will be set in descendants
  646.   if Assigned(FOnPrintColumn) then
  647.     FOnPrintColumn(ColNo, Width);
  648.   FWidth := Width;
  649. end;
  650.  
  651.  
  652. procedure TfrCustomPrintDataSet.SetFooter(const Value: TfrSectionParams);
  653. begin
  654.   FFooter := Value;
  655. end;
  656.  
  657. { TfrPrintTable }
  658.  
  659. constructor TfrPrintTable.Create(AOwner: TComponent);
  660. begin
  661.   inherited Create(AOwner);
  662.   FAutoWidth := True;
  663. end;
  664.  
  665. procedure TfrPrintTable.CreateDS;
  666. var
  667.   i, n: Integer;
  668.   s: String;
  669.   c: TBitmap;
  670. {$IFDEF IBO}
  671.   f: TIB_Column;
  672. {$ELSE}
  673.   f: TField;
  674. {$ENDIF}
  675.  
  676. begin
  677.   if FDataSet = nil then Exit;
  678.   if FAutoWidth then
  679.   begin
  680.     FDataSet.DisableControls;
  681.  
  682.     c := TBitmap.Create;
  683.     c.Width := 16; c.Height := 16;
  684.  
  685.     c.Canvas.Font := FHeader.Font;
  686.     for i := 0 to FDataSet.FieldCount - 1 do
  687.       FWidths[i] := c.Canvas.TextWidth(FDataSet.Fields[RealColumnIndex(i)].DisplayLabel) {* 96 div Screen.PixelsPerInch} + 8; //--- workaround to an internal FR bug
  688.  
  689.     c.Canvas.Font := FBody.Font;
  690.     FDataSet.First;
  691.     while not FDataSet.EOF do
  692.     begin
  693.       for i := 0 to FDataSet.FieldCount - 1 do
  694.       begin
  695.         f := FDataSet.Fields[i];
  696.  
  697.         if f.InheritsFrom(TBLOBField) then
  698.           s:=Trim(f.AsString)
  699.         else
  700.           s:=Trim(f.DisplayText);
  701.  
  702.         n := c.Canvas.TextWidth(s) {* 96 div Screen.PixelsPerInch} + 8; //--- workaround to an internal FR bug
  703.  
  704.         if n > FWidths[i] then
  705.           FWidths[i] := n;
  706.       end;
  707.       FDataSet.Next;
  708.     end;
  709.     c.Free;
  710.  
  711.     FDataSet.EnableControls;
  712.   end;
  713. end;
  714.  
  715. procedure TfrPrintTable.Notification(AComponent: TComponent; Operation: TOperation);
  716. begin
  717.   inherited Notification(AComponent, Operation);
  718.   if (Operation = opRemove) and (AComponent = DataSet) then
  719.     DataSet := nil;
  720. end;
  721.  
  722. procedure TfrPrintTable.OnEnterRect(Memo: TStringList; View: TfrView);
  723. var
  724. {$IFDEF IBO}
  725.   f: TIB_Column;
  726. {$ELSE}
  727.   f: TField;
  728. {$ENDIF}
  729.   s: TfrDataSection;
  730.  
  731. begin
  732.   s:=frOther;
  733.  
  734.   if Memo[0] = '[Cell]' then
  735.   begin
  736.     f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
  737.     if f.InheritsFrom(TBLOBField) then
  738.       Memo[0] := Trim(f.AsString)
  739.     else
  740.       Memo[0] := Trim(f.DisplayText);
  741.  
  742.     s:=frData;
  743.  
  744.     View.dx := FWidth;
  745.     case f.Alignment of
  746.       taLeftJustify : TfrMemoView(View).Alignment := frtaLeft;
  747.       taRightJustify: TfrMemoView(View).Alignment := frtaRight;
  748.       taCenter      : TfrMemoView(View).Alignment := frtaCenter;
  749.     end;
  750.   end;
  751.   if Memo[0] = '[Header]' then
  752.   begin
  753.     f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
  754.     Memo[0] := f.DisplayLabel;
  755.     s:=frHeader;
  756.  
  757.     View.dx := FWidth;
  758.   end;
  759.  
  760.   if Memo[0] = '[Footer]' then
  761.   begin
  762.     Memo[0] := '';
  763.     s:=frFooter;
  764.     View.dx := FWidth;
  765.   end;
  766.   if Assigned(FOnPrintData) then
  767.     FOnPrintData(FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)], Memo, View, s);
  768. end;
  769.  
  770. procedure TfrPrintTable.OnPrintColumn_(ColNo: Integer; var Width: Integer);
  771. var
  772.   c: TBitmap;
  773.   n, n1: Integer;
  774. begin
  775.   if FAutoWidth then
  776. //    Width := FWidths[RealColumnIndex(ColNo - 1)]
  777.     Width :=FWidths[ColNo-1]
  778.   else
  779.   begin
  780.     c := TBitmap.Create;
  781.     c.Width := 16; c.Height := 16;
  782.     c.Canvas.Font := FBody.Font;
  783.     n := FDataSet.Fields[RealColumnIndex(ColNo - 1)].DisplayWidth;
  784.     n1 := Length(FDataSet.Fields[RealColumnIndex(ColNo - 1)].DisplayLabel);
  785.     if n1 > n then
  786.       n := n1;
  787.     Width := c.Canvas.TextWidth('0') * n + 8;
  788.     c.Free;
  789.   end;
  790.   FWidth := Width;
  791.   inherited OnPrintColumn_(ColNo, Width);
  792. end;
  793.  
  794.  
  795. { TfrPrintGrid }
  796.  
  797. {$IFNDEF IBO}
  798. type
  799.   THackDBGrid = class(TDBGrid)
  800.   end;
  801.  
  802. procedure TfrPrintGrid.CreateDS;
  803. begin
  804.   if (FDBGrid = nil) or (DBGrid.DataSource = nil) or
  805.      (DBGrid.DataSource.Dataset = nil) then Exit;
  806.   FDataSet := DBGrid.DataSource.Dataset;
  807. end;
  808.  
  809. procedure TfrPrintGrid.Notification(AComponent: TComponent; Operation: TOperation);
  810. begin
  811.   inherited Notification(AComponent, Operation);
  812.   if (Operation = opRemove) and (AComponent = DBGrid) then
  813.     DBGrid := nil;
  814. end;
  815.  
  816. function TfrPrintGrid.GetFieldCount: Integer;
  817. var
  818.   i: Integer;
  819. begin
  820.   if DBGrid.Columns.Count = 0 then
  821.     Result := inherited GetFieldCount
  822.   else
  823.   begin
  824.     Result := 0;
  825.     for i := 0 to DBGrid.Columns.Count - 1 do
  826.       if DBGrid.Columns[i].Width > 0 then
  827.         Inc(Result);
  828.   end;
  829. end;
  830.  
  831. function TfrPrintGrid.RealGridIndex(Index: Integer): Integer;
  832. var
  833.   Y, I: Integer;
  834. begin
  835.   Result := 0;
  836.   Y := -1;
  837.   for I := 0 to DBGrid.Columns.Count - 1 do
  838.     if DBGrid.Columns[i].Width > 0 then
  839.     begin
  840.       Inc(Y);
  841.       if Y = Index then
  842.       begin
  843.         Result := I;
  844.         break;
  845.       end;
  846.     end;
  847. end;
  848.  
  849. procedure TfrPrintGrid.OnEnterRect(Memo: TStringList; View: TfrView);
  850. var
  851. {$IFDEF IBO}
  852.   f: TIB_Column;
  853. {$ELSE}
  854.   f: TField;
  855. {$ENDIF}
  856. begin
  857.   if Memo[0] = '[Cell]' then
  858.   begin
  859.     if DBGrid.Columns.Count = 0 then
  860.       f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)] else
  861.       f := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Field;
  862.     Memo[0] := f.DisplayText;
  863.     View.dx := FWidth;
  864.     case f.Alignment of
  865.       taLeftJustify : TfrMemoView(View).Alignment := frtaLeft;
  866.       taRightJustify: TfrMemoView(View).Alignment := frtaRight;
  867.       taCenter      : TfrMemoView(View).Alignment := frtaCenter;
  868.     end;
  869.   end;
  870.   if Memo[0] = '[Header]' then
  871.   begin
  872.     if DBGrid.Columns.Count = 0 then
  873.     begin
  874.       f := FDataSet.Fields[RealColumnIndex(FColumnDataSet.RecNo)];
  875.       Memo[0] := f.DisplayLabel;
  876.     end
  877.     else
  878.       Memo[0] := DBGrid.Columns[RealGridIndex(FColumnDataSet.RecNo)].Title.Caption;
  879.     View.dx := FWidth;
  880.   end;
  881. end;
  882.  
  883. procedure TfrPrintGrid.OnPrintColumn_(ColNo: Integer; var Width: Integer);
  884. var
  885.   d: Integer;
  886. begin
  887.   if dgIndicator in DBGrid.Options then
  888.     d := 1 else
  889.     d := 0;
  890.   Width := THackDBGrid(DBGrid).ColWidths[RealGridIndex(ColNo - 1) + d];
  891.   inherited OnPrintColumn_(ColNo, Width);
  892. end;
  893. {$ENDIF}
  894.  
  895.  
  896. end.
  897.  
  898.  
  899.