全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1715
推到 Plurk!
推到 Facebook!

如何修改供FastReportv2.3版轉出PDF文件的元件為Forv2.4版(附Source)

尚未結案
ernest
一般會員


發表:17
回覆:21
積分:7
註冊:2002-04-15

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-02-14 10:19:32 IP:61.30.xxx.xxx 未訂閱
請問各位, 小弟下載了一個專供FastReport轉出PDF文件的Filter元件,  但其原始Support的FastReport的版本是2.3版的, 因此小弟嘗試將之改 成可供v2.4版使用, 但一直無法成功, 因此想請各位協助一下, 底下是 小弟修改過的Source, 如有違反貼版規則, 請版主刪除此文章, 謝謝!!    另外此元件亦有使用參考另外的其他二項元件, 由於無法上傳檔案, 因此小弟將超連結列示如下: PowerPDF http://www.est.hi-ho.ne.jp/takeshi_kanno/powerpdf/ ZLib Units Delphi 5-6 http://www.base2ti.com/zlib.htm 底下是Source: unit FR_E_TNPDF; interface {$I FR.inc} uses SysUtils, Windows, Messages, Classes, Graphics, Forms, StdCtrls, FR_BarC, FR_Class, PdfDoc, PdfTypes, PdfFonts, PReport, Dialogs, Controls, ZLibEx; type // TfrTNPDFExport = class(TComponent) // fake component // end; TfrTNPDFExportFilter = class(TfrExportFilter) private NewPage: Boolean; PDF: TPReport; PPage: TPRPage; PRPanel: TPRPanel; FOutline: TPROutLineEntry; FPageNo : Integer; DummyControl: TForm; public // constructor Create(AStream: TStream); override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure OnBeginPage; override; procedure OnEndPage; override; procedure ShowBackGround(View: TfrView; x, y, h, w: integer); procedure Frame(View: TfrView; x, y, h, w: integer); procedure ShowFrame(View: TfrView; x, y, h, w: integer); procedure ShowBarCode(View: TfrBarCodeView; x, y, h, w: integer); procedure ShowPicture(View: TfrPictureView; x, y, h, w: integer); // procedure OnText(X, Y: Integer; const Text: string; View: TfrView); override; procedure OnText(DrawRect: TRect; x, y: Integer; const text: String; FrameTyp: Integer; View: TfrView); override; procedure OnData(x, y: Integer; View: TfrView); override; end; implementation uses FR_Const; type TfrMemoView_ = class(TfrMemoView); TPRText_ = class(TPRText); const PDFEscx = 0.8; PDFEscy = 0.8; //constructor TfrTNPDFExportFilter.Create(AStream: TStream); constructor TfrTNPDFExportFilter.Create(AOwner: TComponent); begin inherited Create(AOwner); frRegisterExportFilter(Self, 'Adobe Acrobat PDF ' ' (*.pdf)', '*.pdf'); PDF := TPReport.Create(nil); PDF.CompressionMethod := cmFlateDecode; PDF.UseOutlines := True; PDF.PageLayout := plOneColumn; PDF.BeginDoc; DummyControl := TForm.Create(nil); NewPage := False; FPageNo := 0; end; destructor TfrTNPDFExportFilter.Destroy; begin PDF.GetPdfDoc.SaveToStream(Stream); PDF.Free; DummyControl.Free; FreeAndNil(DummyControl); inherited; end; procedure TfrTNPDFExportFilter.OnBeginPage; begin {Add New Page} Inc(FPageNo); PPage := TPRPage.Create(PDF); PPage.Parent := DummyControl; PPage.MarginBottom := 0; PPage.MarginTop := 0; PPage.MarginLeft := 0; PPage.MarginRight := 0; PPage.Height := trunc(CurReport.EMFPages[FPageNo - 1].PrnInfo.Pgh*PDFEscy); PPage.Width := trunc(CurReport.EMFPages[FPageNo - 1].PrnInfo.Pgw*PDFEscx); PRPanel := TPRPanel.Create(PPage); PRPanel.Parent := PPage; PRPanel.Left := 0; PRPanel.Top := 0; PRPanel.Width := PPage.Width; PRPanel.Height := PPage.Height; end; procedure TfrTNPDFExportFilter.OnEndPage; begin PDF.Print(PPage); FOutline := PDF.OutlineRoot.AddChild; FOutline.Dest := PDF.CreateDestination; FOutline.Dest.Top := 0; FOutline.Title := 'Page ' IntToStr(FPageNo); FreeAndNil(PPage); end; procedure TfrTNPDFExportFilter.ShowBackGround(View: TfrView; x, y, h, w: integer); var PRRect: TPRRect; begin PRRect := TPRRect.Create(PRPanel); PRRect.Parent := PRPanel; PRRect.FillColor := View.FillColor; PRRect.LineColor := clNone; PRRect.LineStyle := psSolid; PRRect.Left := x; PRRect.Top := y; PRRect.Height := h; PRRect.Width := w; end; procedure TfrTNPDFExportFilter.Frame(View: TfrView; x, y, h, w: integer); var PRRect: TPRRect; begin PRRect := TPRRect.Create(PRPanel); PRRect.Parent := PRPanel; PRRect.FillColor := clNone; PRRect.Left := x; PRRect.Top := y; PRRect.Height := h; PRRect.Width := w; PRRect.LineStyle := TPenStyle(View.FrameStyle); PRRect.LineWidth := View.FrameWidth - 0.5; PRRect.LineColor := View.FrameColor; end; procedure TfrTNPDFExportFilter.ShowFrame(View: TfrView; x, y, h, w: integer); begin if ((View.FrameTyp and $F) = $F) and (View.FrameStyle = 0) then begin Frame(View, x, y, h, w); end else begin if (View.FrameTyp and $1) <> 0 then Frame(View, x w - 1, y, h, 0); //Right if (View.FrameTyp and $4) <> 0 then Frame(View, x, y, h, 0); //Left if (View.FrameTyp and $2) <> 0 then Frame(View, x, y h - 1, 0, w); //Botton if (View.FrameTyp and $8) <> 0 then Frame(View, x, y, 0, w); //Top end; end; procedure TfrTNPDFExportFilter.ShowBarCode(View: TfrBarCodeView; x, y, h, w: integer); var Bitmap: TBitmap; PRImage: TPRImage; oldX, oldY: Integer; begin oldX := View.x; oldy := View.y; View.x := 0; View.y := 0; Bitmap := TBitmap.Create; try PRImage := TPRImage.Create(PRPanel); PRImage.Parent := PRPanel; PRImage.Stretch := True; PRImage.SharedImage := False; PRImage.Left := x; PRImage.Top := y; PRImage.Height := h; PRImage.Width := w; Bitmap.Height := View.dy; Bitmap.Width := View.dx; TfrBarCodeView(View).Draw(Bitmap.Canvas); PRImage.Picture.Bitmap := Bitmap; finally FreeAndNil(Bitmap); end; View.x := oldX; View.y := oldY; end; procedure TfrTNPDFExportFilter.ShowPicture(View: TfrPictureView; x, y, h, w: integer); var Bitmap: TBitmap; PRImage: TPRImage; begin Bitmap := TBitmap.Create; try PRImage := TPRImage.Create(PRPanel); PRImage.Parent := PRPanel; PRImage.Stretch := True; PRImage.SharedImage := False; PRImage.Left := x; PRImage.Top := y; PRImage.Height := h; PRImage.Width := w; Bitmap.Height := View.Picture.Height; Bitmap.Width := View.Picture.Width; Bitmap.Canvas.Draw(0, 0, View.Picture.Graphic); PRImage.Picture.Bitmap := Bitmap; finally FreeAndNil(Bitmap); end; end; procedure TfrTNPDFExportFilter.OnData(x, y: Integer; View: TfrView); var nx, ny, ndx, ndy: Integer; begin nx := Round(x * PDFEscx); ny := Round(y * PDFEscy); ndx := Round((View.dx) * PDFEscx 1) ; ndy := Round((View.dy) * PDFEscy 1) ; if View.FillColor <> clNone then ShowBackGround(View, nx, ny, ndy, ndx); if View is TfrBarCodeView then ShowBarCode(TfrBarCodeView(View), nx, ny, ndy, ndx) else if View is TfrPictureView then ShowPicture(TfrPictureView(View), nx, ny, ndy, ndx); // For debugging only // else if not View is TfrMemoView then // MessageDlg(View.ClassName, mtWarning, [mbOK], 0); if ((View.FrameTyp and $F) <> 0) and not (View is TfrBarCodeView) then ShowFrame(View, nx, ny, ndy, ndx); end; //procedure TfrTNPDFExportFilter.OnText(X, Y: Integer; const Text: string; // View: TfrView); procedure TfrTNPDFExportFilter.OnText(DrawRect: TRect; x, y: Integer; const text: String; FrameTyp: Integer; View: TfrView); var PRTLabel: TPRText; nx, ny, ndx, ndy: Integer; begin nx := Round(x * PDFEscx) 1; ny := Round(y * PDFEscy) 1; ndx := Round(View.dx * PDFEscx); ndy := Round(View.dy * PDFEscy); PRTLabel := TPRText.Create(PRPanel); PRTLabel.Parent := PRPanel; try PRTLabel.Text := Text; PRTLabel.Left := nx; PRTLabel.Top := ny; PRTLabel.Width := ndx; PRTLabel.Height := ndy; if View is TfrMemoView then begin if Pos('Arial', TfrMemoView_(View).Font.Name) > 0 then PRTLabel.FontName := fnArial else if Pos('Courier', TfrMemoView_(View).Font.Name) > 0 then PRTLabel.FontName := fnFixedWidth else if Pos('Times', TfrMemoView_(View).Font.Name) > 0 then PRTLabel.FontName := fnTimesRoman; PRTLabel.FontSize := TfrMemoView_(View).Font.Size; PRTLabel.FontBold := fsBold in TfrMemoView_(View).Font.Style; PRTLabel.FontItalic := fsItalic in TfrMemoView_(View).Font.Style; PRTLabel.FontColor := TfrMemoView_(View).Font.Color; end; finally end; end; initialization { procedure frRegisterExportFilter(Filter: TfrExportFilter; const FilterDesc, FilterExt: String); frRegisterExportFilter(TfrTNPDFExportFilter, 'Adobe Acrobat PDF ' ' (*.pdf)', '*.pdf'); } // frRegisterExportFilter(TfrTNPDFExportFilter, 'Adobe Acrobat PDF ' ' (*.pdf)', '*.pdf'); // RegisterComponents('FastReport', [TfrTNPDFExportFilter]); end.
系統時間:2024-05-03 19:12:05
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!