Source code of file oscpmwin/fr_e_tnpdf.pas from the
osCommerce Product Manager for Windows.
0000: {****************************************************}
0001: { }
0002: { FastReport v2.3 }
0003: { PDF export filter Ver 1.0 }
0004: { }
0005: { By : Ricardo Cardona Ramirez }
0006: { }
0007: { PowerPDF }
0008: { http://www.est.hi-ho.ne.jp/takeshi_kanno/powerpdf/ }
0009: { ZLib Units Delphi 5-6 }
0010: { http://www.base2ti.com/zlib.htm }
0011: { }
0012: {****************************************************}
0013:
0014: unit fr_e_tnpdf;
0015:
0016: interface
0017:
0018: {$I FR.inc}
0019:
0020: uses
0021: SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, FR_BarC,
0022: FR_Class, PdfDoc, PdfTypes, PdfFonts, PReport, Dialogs, Controls;
0023:
0024: type
0025: TfrTNPDFExport = class(TComponent) // fake component
0026: end;
0027:
0028: TfrTNPDFExportFilter = class(TfrExportFilter)
0029: private
0030: NewPage: Boolean;
0031: PDF: TPReport;
0032: PPage: TPRPage;
0033: PRPanel: TPRPanel;
0034: FOutline: TPROutLineEntry;
0035: FPageNo : Integer;
0036: DummyControl: TForm;
0037: public
0038: constructor Create(AStream: TStream); override;
0039: destructor Destroy; override;
0040: procedure OnBeginPage; override;
0041: procedure OnEndPage; override;
0042: procedure ShowBackGround(View: TfrView; x, y, h, w: integer);
0043: procedure Frame(View: TfrView; x, y, h, w: integer);
0044: procedure ShowFrame(View: TfrView; x, y, h, w: integer);
0045: procedure ShowBarCode(View: TfrBarCodeView; x, y, h, w: integer);
0046: procedure ShowPicture(View: TfrPictureView; x, y, h, w: integer);
0047: procedure OnText(X, Y: Integer; const Text: string; View: TfrView);
0048: override;
0049: procedure OnData(x, y: Integer; View: TfrView); override;
0050: end;
0051:
0052: implementation
0053:
0054: uses FR_Const, oscpmdata, dataman;
0055:
0056: type
0057: TfrMemoView_ = class(TfrMemoView);
0058: TPRText_ = class(TPRText);
0059:
0060: const
0061: PDFEscx = 0.8;
0062: PDFEscy = 0.8;
0063:
0064: constructor TfrTNPDFExportFilter.Create(AStream: TStream);
0065: begin
0066: inherited;
0067: PDF := TPReport.Create(nil);
0068: PDF.CompressionMethod := cmNone;
0069: PDF.UseOutlines := True;
0070: PDF.PageLayout := plOneColumn;
0071: PDF.Creator := opmC_AppShortName + ' ' + opmC_Version + ' (build ' + opmG_ExeBuildVersion + ')';
0072: PDF.Author := opmG_PDFAuthor;
0073: PDF.Title := opmG_Cur_PPrintTitle;
0074: PDF.Subject := opmG_Cur_PDFSubject;
0075: PDF.Keywords := '';
0076: PDF.BeginDoc;
0077: DummyControl := TForm.Create(nil);
0078: NewPage := False;
0079: FPageNo := 0;
0080: end;
0081:
0082: destructor TfrTNPDFExportFilter.Destroy;
0083: begin
0084: PDF.GetPdfDoc.SaveToStream(Stream);
0085: PDF.Free;
0086: DummyControl.Free;
0087: inherited;
0088: end;
0089:
0090: procedure TfrTNPDFExportFilter.OnBeginPage;
0091: begin
0092: {Add New Page}
0093: Inc(FPageNo);
0094:
0095: PPage := TPRPage.Create(PDF);
0096: PPage.Parent := DummyControl;
0097: PPage.MarginBottom := 0;
0098: PPage.MarginTop := 0;
0099: PPage.MarginLeft := 0;
0100: PPage.MarginRight := 0;
0101:
0102: PPage.Height := trunc(CurReport.EMFPages[FPageNo - 1].PrnInfo.Pgh*PDFEscy);
0103: PPage.Width := trunc(CurReport.EMFPages[FPageNo - 1].PrnInfo.Pgw*PDFEscx);
0104:
0105: PRPanel := TPRPanel.Create(PPage);
0106: PRPanel.Parent := PPage;
0107: PRPanel.Left := 0;
0108: PRPanel.Top := 0;
0109: PRPanel.Width := PPage.Width;
0110: PRPanel.Height := PPage.Height;
0111: end;
0112:
0113: procedure TfrTNPDFExportFilter.OnEndPage;
0114: begin
0115: PDF.Print(PPage);
0116:
0117: FOutline := PDF.OutlineRoot.AddChild;
0118: FOutline.Dest := PDF.CreateDestination;
0119: FOutline.Dest.Top := 0;
0120: FOutline.Title := 'Page ' + IntToStr(FPageNo);
0121:
0122: FreeAndNil(PPage);
0123: end;
0124:
0125: procedure TfrTNPDFExportFilter.ShowBackGround(View: TfrView; x, y, h, w:
0126: integer);
0127: var
0128: PRRect: TPRRect;
0129: begin
0130: PRRect := TPRRect.Create(PRPanel);
0131: PRRect.Parent := PRPanel;
0132: PRRect.FillColor := View.FillColor;
0133: PRRect.LineColor := clNone;
0134: PRRect.LineStyle := psSolid;
0135: PRRect.Left := x;
0136: PRRect.Top := y;
0137: PRRect.Height := h;
0138: PRRect.Width := w;
0139: end;
0140:
0141: procedure TfrTNPDFExportFilter.Frame(View: TfrView; x, y, h, w: integer);
0142: var
0143: PRRect: TPRRect;
0144: begin
0145: PRRect := TPRRect.Create(PRPanel);
0146: PRRect.Parent := PRPanel;
0147: PRRect.FillColor := clNone;
0148:
0149: PRRect.Left := x;
0150: PRRect.Top := y;
0151: PRRect.Height := h;
0152: PRRect.Width := w;
0153:
0154: PRRect.LineStyle := TPenStyle(View.FrameStyle);
0155: PRRect.LineWidth := View.FrameWidth - 0.5;
0156: PRRect.LineColor := View.FrameColor;
0157: end;
0158:
0159: procedure TfrTNPDFExportFilter.ShowFrame(View: TfrView; x, y, h, w: integer);
0160: begin
0161: if ((View.FrameTyp and $F) = $F) and (View.FrameStyle = 0) then
0162: begin
0163: Frame(View, x, y, h, w);
0164: end
0165: else
0166: begin
0167: if (View.FrameTyp and $1) <> 0 then
0168: Frame(View, x + w - 1, y, h, 0); //Right
0169: if (View.FrameTyp and $4) <> 0 then
0170: Frame(View, x, y, h, 0); //Left
0171: if (View.FrameTyp and $2) <> 0 then
0172: Frame(View, x, y + h - 1, 0, w); //Botton
0173: if (View.FrameTyp and $8) <> 0 then
0174: Frame(View, x, y, 0, w); //Top
0175: end;
0176: end;
0177:
0178: procedure TfrTNPDFExportFilter.ShowBarCode(View: TfrBarCodeView; x, y, h, w:
0179: integer);
0180: var
0181: Bitmap: TBitmap;
0182: PRImage: TPRImage;
0183: oldX, oldY: Integer;
0184: begin
0185: oldX := View.x;
0186: oldy := View.y;
0187: View.x := 0;
0188: View.y := 0;
0189: Bitmap := TBitmap.Create;
0190: try
0191: PRImage := TPRImage.Create(PRPanel);
0192: PRImage.Parent := PRPanel;
0193: PRImage.Stretch := True;
0194: PRImage.SharedImage := False;
0195: PRImage.Left := x;
0196: PRImage.Top := y;
0197: PRImage.Height := h;
0198: PRImage.Width := w;
0199:
0200: Bitmap.Height := View.dy;
0201: Bitmap.Width := View.dx;
0202:
0203: TfrBarCodeView(View).Draw(Bitmap.Canvas);
0204:
0205: PRImage.Picture.Bitmap := Bitmap;
0206: finally
0207: FreeAndNil(Bitmap);
0208: end;
0209: View.x := oldX;
0210: View.y := oldY;
0211: end;
0212:
0213: procedure TfrTNPDFExportFilter.ShowPicture(View: TfrPictureView; x, y, h,
0214: w: integer);
0215: var
0216: Bitmap: TBitmap;
0217: PRImage: TPRImage;
0218: begin
0219: Bitmap := TBitmap.Create;
0220: try
0221: PRImage := TPRImage.Create(PRPanel);
0222: PRImage.Parent := PRPanel;
0223: PRImage.Stretch := True;
0224: PRImage.SharedImage := False;
0225: PRImage.Left := x;
0226: PRImage.Top := y;
0227: PRImage.Height := h;
0228: PRImage.Width := w;
0229: Bitmap.Height := View.Picture.Height;
0230: Bitmap.Width := View.Picture.Width;
0231: Bitmap.Canvas.Draw(0, 0, View.Picture.Graphic);
0232: PRImage.Picture.Bitmap := Bitmap;
0233: finally
0234: FreeAndNil(Bitmap);
0235: end;
0236: end;
0237:
0238: procedure TfrTNPDFExportFilter.OnData(x, y: Integer; View: TfrView);
0239: var
0240: nx, ny, ndx, ndy: Integer;
0241: begin
0242: nx := Round(x * PDFEscx);
0243: ny := Round(y * PDFEscy);
0244: ndx := Round((View.dx) * PDFEscx + 1) ;
0245: ndy := Round((View.dy) * PDFEscy + 1) ;
0246:
0247: if View.FillColor <> clNone then
0248: ShowBackGround(View, nx, ny, ndy, ndx);
0249:
0250: if View is TfrBarCodeView then
0251: ShowBarCode(TfrBarCodeView(View), nx, ny, ndy, ndx)
0252: else if View is TfrPictureView then
0253: ShowPicture(TfrPictureView(View), nx, ny, ndy, ndx);
0254: // For debugging only
0255: // else if not View is TfrMemoView then
0256: // MessageDlg(View.ClassName, mtWarning, [mbOK], 0);
0257:
0258: if ((View.FrameTyp and $F) <> 0) and not (View is TfrBarCodeView) then
0259: ShowFrame(View, nx, ny, ndy, ndx);
0260: end;
0261:
0262: procedure TfrTNPDFExportFilter.OnText(X, Y: Integer; const Text: string;
0263: View: TfrView);
0264: var
0265: PRTLabel: TPRText;
0266: nx, ny,
0267: ndx, ndy: Integer;
0268: begin
0269: nx := Round(x * PDFEscx) + 1;
0270: ny := Round(y * PDFEscy) + 1;
0271: ndx := Round(View.dx * PDFEscx);
0272: ndy := Round(View.dy * PDFEscy);
0273:
0274: PRTLabel := TPRText.Create(PRPanel);
0275: PRTLabel.Parent := PRPanel;
0276: try
0277: PRTLabel.Text := Text;
0278: PRTLabel.Left := nx;
0279: PRTLabel.Top := ny;
0280: PRTLabel.Width := ndx;
0281: PRTLabel.Height := ndy;
0282: if View is TfrMemoView then
0283: begin
0284: if Pos('Arial', TfrMemoView_(View).Font.Name) > 0 then
0285: PRTLabel.FontName := fnArial
0286: else if Pos('Courier', TfrMemoView_(View).Font.Name) > 0 then
0287: PRTLabel.FontName := fnFixedWidth
0288: else if Pos('Times', TfrMemoView_(View).Font.Name) > 0 then
0289: PRTLabel.FontName := fnTimesRoman;
0290: PRTLabel.FontSize := TfrMemoView_(View).Font.Size;
0291: PRTLabel.FontBold := fsBold in TfrMemoView_(View).Font.Style;
0292: PRTLabel.FontItalic := fsItalic in TfrMemoView_(View).Font.Style;
0293: PRTLabel.FontColor := TfrMemoView_(View).Font.Color;
0294: end;
0295:
0296: finally
0297: end;
0298: end;
0299:
0300: initialization
0301: frRegisterExportFilter(TfrTNPDFExportFilter, 'Adobe Acrobat PDF ' + ' (*.pdf)', '*.pdf');
0302:
0303: end.
0304:
