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:   
 
 
NA fum/lmd: 2007.07.15
Copyright ©1994-2024 by Mario A. Valdez-Ramírez.
no siga este enlace / do not follow this link