home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d56 / FREXPPDF.ZIP / FR_E_TNPDF.PAS < prev    next >
Pascal/Delphi Source File  |  2002-07-02  |  8KB  |  286 lines
  1. {*****************************************}
  2. {                                         }
  3. {             FastReport v2.3             }
  4. {            PDF export filter            }
  5. {                                         }
  6. {       By : Ricardo Cardona Ramirez      }
  7. {                                         }
  8. {*****************************************}
  9.  
  10. unit FR_E_TNPDF;
  11.  
  12. interface
  13.  
  14. {$I FR.inc}
  15.  
  16. uses
  17.     SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, FR_BarC,
  18.     FR_Class, PdfDoc, PdfTypes, PdfFonts, PReport, Dialogs, Controls;
  19.  
  20. type
  21.     TfrTNPDFExport = class(TComponent) // fake component
  22.     end;
  23.  
  24.     TfrTNPDFExportFilter = class(TfrExportFilter)
  25.     private
  26.         NewPage: Boolean;
  27.         PDF: TPReport;
  28.         PPage: TPRPage;
  29.         PRPanel: TPRPanel;
  30.         DummyControl: TForm;
  31.     public
  32.         constructor Create(AStream: TStream); override;
  33.         destructor Destroy; override;
  34.         procedure OnBeginPage; override;
  35.         procedure OnEndPage; override;
  36.         procedure ShowBackGround(View: TfrView; x, y, h, w: integer);
  37.         procedure Frame(View: TfrView; x, y, h, w: integer);
  38.         procedure ShowFrame(View: TfrView; x, y, h, w: integer);
  39.         procedure ShowBarCode(View: TfrBarCodeView; x, y, h, w: integer);
  40.         procedure ShowPicture(View: TfrPictureView; x, y, h, w: integer);
  41.         procedure OnText(X, Y: Integer; const Text: string; View: TfrView);
  42.             override;
  43.         procedure OnData(x, y: Integer; View: TfrView); override;
  44.     end;
  45.  
  46. implementation
  47.  
  48. uses FR_Const;
  49.  
  50. type
  51.     TfrMemoView_ = class(TfrMemoView);
  52.     TPRText_ = class(TPRText);
  53.  
  54. const
  55.     //The magic number :)
  56.     PDFEscx = 0.7915006640106241699867197875166;
  57.     PDFEscy = 0.78544776119402985074626865671642;
  58.  
  59. constructor TfrTNPDFExportFilter.Create(AStream: TStream);
  60. begin
  61.     inherited;
  62.     {Create TPReport VCL}
  63.     PDF := TPReport.Create(nil);
  64.     PDF.CompressionMethod := cmFlateDecode;
  65.     PDF.BeginDoc;
  66.     DummyControl := TForm.Create(nil);
  67.     NewPage := False;
  68. end;
  69.  
  70. destructor TfrTNPDFExportFilter.Destroy;
  71. begin
  72.     PDF.GetPdfDoc.SaveToStream(Stream);
  73.     PDF.Free;
  74.     DummyControl.Free;
  75.     inherited;
  76. end;
  77.  
  78. procedure TfrTNPDFExportFilter.OnBeginPage;
  79. begin
  80.     {Add New Page}
  81.     PPage := TPRPage.Create(PDF);
  82.     PPage.Parent := DummyControl;
  83.     PPage.MarginBottom := 0;
  84.     PPage.MarginTop := 0;
  85.     PPage.MarginLeft := 0;
  86.     PPage.MarginRight := 0;
  87.     //for Multisize pages ┐?
  88.     PPage.Height := trunc(CurReport.EMFPages[0].PrnInfo.Pgh*PDFEscy);
  89.     PPage.Width := trunc(CurReport.EMFPages[0].PrnInfo.Pgw*PDFEscx);
  90.  
  91.     PRPanel := TPRPanel.Create(PPage);
  92.     PRPanel.Parent := PPage;
  93.     PRPanel.Left := 0;
  94.     PRPanel.Top := 0;
  95.     PRPanel.Width := PPage.Width;
  96.     PRPanel.Height := PPage.Height;
  97. end;
  98.  
  99. procedure TfrTNPDFExportFilter.OnEndPage;
  100. begin
  101.     PDF.Print(PPage);
  102.     FreeAndNil(PPage);
  103. end;
  104.  
  105. procedure TfrTNPDFExportFilter.ShowBackGround(View: TfrView; x, y, h, w:
  106.     integer);
  107. var
  108.     PRRect: TPRRect;
  109. begin
  110.     PRRect := TPRRect.Create(PRPanel);
  111.     PRRect.Parent := PRPanel;
  112.     PRRect.FillColor := View.FillColor;
  113.     PRRect.LineColor := View.FillColor;
  114.     PRRect.LineStyle := psSolid;
  115.     PRRect.Left := x;
  116.     PRRect.Top := y;
  117.     PRRect.Height := h;
  118.     PRRect.Width := w;
  119. end;
  120.  
  121. procedure TfrTNPDFExportFilter.Frame(View: TfrView; x, y, h, w: integer);
  122. var
  123.     PRRect: TPRRect;
  124. begin
  125.     PRRect := TPRRect.Create(PRPanel);
  126.     PRRect.Parent := PRPanel;
  127.     PRRect.FillColor := clNone;
  128.  
  129.     PRRect.Left := x;
  130.     PRRect.Top := y;
  131.     PRRect.Height := h;
  132.     PRRect.Width := w;
  133.  
  134.     PRRect.LineStyle := TPenStyle(View.FrameStyle);
  135.     PRRect.LineWidth := View.FrameWidth - 0.5;
  136.     PRRect.LineColor := View.FrameColor;
  137. end;
  138.  
  139. procedure TfrTNPDFExportFilter.ShowFrame(View: TfrView; x, y, h, w: integer);
  140. begin
  141.     if ((View.FrameTyp and $F) = $F) and (View.FrameStyle = 0) then
  142.     begin
  143.         Frame(View, x, y, h, w);
  144.     end
  145.     else
  146.     begin
  147.         if (View.FrameTyp and $1) <> 0 then
  148.             Frame(View, x + w, y, h + 1, 0);
  149.         if (View.FrameTyp and $4) <> 0 then
  150.             Frame(View, x, y, h + 1, 0);
  151.         if (View.FrameTyp and $2) <> 0 then
  152.             Frame(View, x, y + h, 0, w);
  153.         if (View.FrameTyp and $8) <> 0 then
  154.             Frame(View, x, y, 0, w);
  155.     end;
  156. end;
  157.  
  158. procedure TfrTNPDFExportFilter.ShowBarCode(View: TfrBarCodeView; x, y, h, w:
  159.     integer);
  160. var
  161.     Bitmap: TBitmap;
  162.     PRImage: TPRImage;
  163.     oldX, oldY: Integer;
  164. begin
  165.     oldX := View.x;
  166.     oldy := View.y;
  167.     View.x := 0;
  168.     View.y := 0;
  169.     Bitmap := TBitmap.Create;
  170.     try
  171.         PRImage := TPRImage.Create(PRPanel);
  172.         PRImage.Parent := PRPanel;
  173.         PRImage.Stretch := True;
  174.         PRImage.SharedImage := False;
  175.         PRImage.Left := x;
  176.         PRImage.Top := y;
  177.         PRImage.Height := h;
  178.         PRImage.Width := w;
  179.  
  180.         Bitmap.Height := View.dy;
  181.         Bitmap.Width := View.dx;
  182.  
  183.         TfrBarCodeView(View).Draw(Bitmap.Canvas);
  184.  
  185.         PRImage.Picture.Bitmap := Bitmap;
  186.     finally
  187.         FreeAndNil(Bitmap);
  188.     end;
  189.     View.x := oldX;
  190.     View.y := oldY;
  191. end;
  192.  
  193. procedure TfrTNPDFExportFilter.ShowPicture(View: TfrPictureView; x, y, h,
  194.     w: integer);
  195. var
  196.     Bitmap: TBitmap;
  197.     PRImage: TPRImage;
  198. begin
  199.     Bitmap := TBitmap.Create;
  200.     try
  201.         PRImage := TPRImage.Create(PRPanel);
  202.         PRImage.Parent := PRPanel;
  203.         PRImage.Stretch := True;
  204.         PRImage.SharedImage := False;
  205.         PRImage.Left := x;
  206.         PRImage.Top := y;
  207.         PRImage.Height := h;
  208.         PRImage.Width := w;
  209.         Bitmap.Height := View.Picture.Height;
  210.         Bitmap.Width := View.Picture.Width;
  211.         Bitmap.Canvas.Draw(0, 0, View.Picture.Graphic);
  212.         PRImage.Picture.Bitmap := Bitmap;
  213.     finally
  214.         FreeAndNil(Bitmap);
  215.     end;
  216. end;
  217.  
  218. procedure TfrTNPDFExportFilter.OnData(x, y: Integer; View: TfrView);
  219. var
  220.     nx, ny, ndx, ndy: Integer;
  221. begin
  222.     nx := Round(x * PDFEscx);
  223.     ny := Round(y * PDFEscy);
  224.     ndx := Round(View.dx * PDFEscx) + 1;
  225.     ndy := Round(View.dy * PDFEscy) + 1;
  226.  
  227.     if View.FillColor <> clNone then
  228.         ShowBackGround(View, nx, ny, ndy, ndx);
  229.  
  230.     if View is TfrBarCodeView then
  231.         ShowBarCode(TfrBarCodeView(View), nx, ny, ndy, ndx)
  232.     else if View is TfrPictureView then
  233.         ShowPicture(TfrPictureView(View), nx, ny, ndy, ndx);
  234.         //   For debugging only
  235.         //    else if not View is  TfrMemoView then
  236.         //        MessageDlg(View.ClassName, mtWarning, [mbOK], 0);
  237.  
  238.     if ((View.FrameTyp and $F) <> 0) and not (View is TfrBarCodeView) then
  239.        ShowFrame(View, nx, ny, ndy, ndx);
  240. end;
  241.  
  242. procedure TfrTNPDFExportFilter.OnText(X, Y: Integer; const Text: string;
  243.     View: TfrView);
  244. var
  245.     PRTLabel: TPRText;
  246.     nx, ny,
  247.         ndx, ndy: Integer;
  248. begin
  249.     nx := Round(x * PDFEscx) + 1;
  250.     ny := Round(y * PDFEscy) + 1;
  251.     ndx := Round(View.dx * PDFEscx);
  252.     ndy := Round(View.dy * PDFEscy);
  253.  
  254.     PRTLabel := TPRText.Create(PRPanel);
  255.     PRTLabel.Parent := PRPanel;
  256.     try
  257.         PRTLabel.Text := Text;
  258.         PRTLabel.Left := nx;
  259.         PRTLabel.Top := ny;
  260.         PRTLabel.Width := ndx;
  261.         PRTLabel.Height := ndy;
  262.         if View is TfrMemoView then
  263.         begin
  264.             if Pos('Arial', TfrMemoView_(View).Font.Name) > 0 then
  265.                 PRTLabel.FontName := fnArial
  266.             else if Pos('Courier', TfrMemoView_(View).Font.Name) > 0 then
  267.                 PRTLabel.FontName := fnFixedWidth
  268.             else if Pos('Times', TfrMemoView_(View).Font.Name) > 0 then
  269.                 PRTLabel.FontName := fnTimesRoman;
  270.             PRTLabel.FontSize := TfrMemoView_(View).Font.Size;
  271.             PRTLabel.FontBold := fsBold in TfrMemoView_(View).Font.Style;
  272.             PRTLabel.FontItalic := fsItalic in TfrMemoView_(View).Font.Style;
  273.             PRTLabel.FontColor := TfrMemoView_(View).Font.Color;
  274.         end;
  275.  
  276.     finally
  277.     end;
  278. end;
  279.  
  280. initialization
  281.     frRegisterExportFilter(TfrTNPDFExportFilter, 'Adobe Acrobat Pdf ' + ' (*.pdf)',
  282.         '*.pdf');
  283.  
  284. end.
  285.  
  286.