www.pudn.com > PDF-Library.rar > quickpdf.pas, change:2016-12-27,size:15649b


unit quickpdf; 
 
{$I VerCtrl.inc} 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  QPDFRender, QPDFFrontEnd, Contnrs; 
 
type 
  TQuickPdfDocument = class; 
  TQuickPdfContentsItem = class; 
  TQuickPdfPageInfo = class; 
  TQuickPdfSecurityMode = (secDisabled,sec40bit,sec128bit); 
  TQuickPdfSecurityOptions = set of (secPrint,secExtraction,secModify); 
 
  TQuickPdf = class(TComponent) 
  private 
    FFileName: String; 
    FDocument: TQuickPdfDocument; 
    FContents: TQuickPdfContentsItem; 
    FEmbedded: Boolean; 
    FPageInfo: TQuickPdfPageInfo; 
    FAuthor:    String; 
    FTitle:     String; 
    FCreator:   String; 
    FKeywords:  String; 
    FSubject:   String; 
    FSecurity:  TQuickPdfSecurityMode; 
    FOwnerPassword: String; 
    FUserPassword: String; 
    FSecurityOptions: TQuickPdfSecurityOptions; 
    function    GetDocument: TQuickPdfDocument; 
  protected 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor  Destroy; override; 
    procedure   GenerateToStream( stream: TStream ); 
    procedure   GenerateToFile; 
    function    GenerateToString: String; 
    property    Document: TQuickPdfDocument read GetDocument; 
    property    Contents: TQuickPdfContentsItem read FContents; 
    procedure   Clear; 
  published 
    property    EmbeddedFonts: Boolean read FEmbedded write FEmbedded default True; 
    property    FileName: String read FFileName write FFileName; 
    property    PageInfo: TQuickPdfPageInfo read FPageInfo write FPageInfo; 
    property    PdfAuthor: String read FAuthor write FAuthor; 
    property    PdfTitle: String read FTitle write FTitle; 
    property    PdfCreator: String read FCreator write FCreator; 
    property    PdfSubject: String read FSubject write FSubject; 
    property    PdfKeywords: String read FKeywords write FKeywords; 
    property    Security: TQuickPdfSecurityMode read FSecurity write FSecurity; 
    property    SecurityUserPassword: String read FUserPassword write FUserPassword; 
    property    SecurityOwnerPassword: String read FOwnerPassword write FOwnerPassword; 
    property    SecurityOptions: TQuickPdfSecurityOptions read FSecurityOptions write FSecurityOptions; 
  end; 
 
  TQuickPdfDocument = class 
  private 
    FTable: TRenderTable; 
    FWidth: Integer; 
    function GetFooter: TRenderCell; 
    function GetHeader: TRenderCell; 
    function GetSection(Index: Integer): TRenderCell; 
    procedure Clear; 
    procedure Start( page: TQuickPdfPageInfo ); 
  public 
    constructor Create; 
    destructor Destroy; override; 
    procedure SetMargins( left, top, right, bottom: Integer ); 
    property Section[Index: Integer]: TRenderCell read GetSection; 
    property Header: TRenderCell read GetHeader; 
    property Footer: TRenderCell read GetFooter; 
    property MainTable: TRenderTable read FTable; 
  end; 
 
  TQuickPdfContentsItem = class 
  private 
    FParent: TQuickPdfContentsItem; 
    FItems: TObjectList; 
    function GetCounter: Integer; 
    function GetItem(Index: Integer): TQuickPdfContentsItem; 
  protected 
    constructor Create; overload; 
    constructor Create( ATitle, ALink: String; AParent: TQuickPdfContentsItem = nil ); overload; 
  public 
    Title, Link: String; 
    destructor Destroy; override; 
    procedure Clear; 
    function Add( ATitle, ALink: String ): TQuickPdfContentsItem; 
    property Count: Integer read GetCounter; 
    property Parent: TQuickPdfContentsItem read FParent write FParent; 
    property Items[Index: Integer]: TQuickPdfContentsItem read GetItem; default; 
  end; 
 
  TQuickPdfPageSize = (psCustom,psA4,psLetter,psLegal); 
 
  TQuickPdfPageInfo = class(TPersistent) 
  private 
    FHeight: Integer; 
    FMarginLeft: Integer; 
    FWidth: Integer; 
    FMarginRight: Integer; 
    FMarginTop: Integer; 
    FMarginBottom: Integer; 
    FSize: TQuickPdfPageSize; 
    procedure SetSize(const Value: TQuickPdfPageSize); 
    procedure SetWidth(Value: Integer); 
    procedure SetHeight(Value: Integer); 
    procedure SetMarginLeft(Value: Integer); 
    procedure SetMarginRight(Value: Integer); 
    procedure SetMarginTop(Value: Integer); 
    procedure SetMarginBottom(Value: Integer); 
  protected 
    procedure AssignTo(Dest: TPersistent); override; 
  published 
    constructor Create; 
    property Size: TQuickPdfPageSize read FSize write SetSize; 
    property Width: Integer read FWidth write SetWidth; 
    property Height: Integer read FHeight write SetHeight; 
    property MarginLeft: Integer read FMarginLeft write SetMarginLeft; 
    property MarginRight: Integer read FMarginRight write SetMarginRight; 
    property MarginTop: Integer read FMarginTop write SetMarginTop; 
    property MarginBottom: Integer read FMarginBottom write SetMarginBottom; 
  end; 
 
implementation 
 
{$IFDEF TRIAL} 
uses fuQPdfAbout; 
{$ENDIF} 
 
const 
    VERSION = '1.00'; 
 
type 
  TPdfWriter = class(TRenderWriter) 
  private 
    ctx: TPdfContext; 
  public 
    constructor Create( _ctx: TPdfContext ); 
    procedure DrawLine( x, y, dx, dy: Integer ); override; 
    procedure DrawRect( x, y, width, height: Integer ); override; 
    procedure FillRect( x, y, width, height, color: Integer ); override; 
    procedure DrawWord( x, y: Integer; Word: String; Font: TFont ); override; 
    procedure DrawImage( x, y, width, height: Integer; Image: TGraphic; Raster: Boolean ); override; 
    procedure SetLink( Target: String; Bounds: TRect ); override; 
    procedure ResolveLink( Target: String; X, Y: Integer ); override; 
  end; 
 
{ TMyWriter } 
 
constructor TPdfWriter.Create(_ctx: TPdfContext); 
begin 
    inherited Create; 
    ctx := _ctx; 
end; 
 
procedure TPdfWriter.DrawLine(x, y, dx, dy: Integer); 
begin 
    ctx.Page.WriteStrokeColor( DrawColor ); 
    ctx.page.WriteLineWidth( DrawThinkness ); 
    ctx.page.WriteLine( x, y, dx, dy ); 
end; 
 
procedure TPdfWriter.DrawRect(x, y, width, height: Integer); 
begin 
    ctx.page.WriteStrokeColor( DrawColor ); 
    ctx.page.WriteLineWidth( DrawThinkness ); 
    ctx.page.WriteRect( x, y, width, height ); 
end; 
 
procedure TPdfWriter.FillRect(x, y, width, height, color: Integer); 
begin 
    ctx.page.WriteFillColor( color ); 
    ctx.page.WriteFillRect( x, y, width, height ); 
end; 
 
procedure TPdfWriter.DrawWord( x, y: Integer; Word: String; Font: TFont ); 
begin 
    ctx.page.Context.CurTextColor := Font.Color; 
    ctx.page.Context.SetFont( Font.Name, Font.Height, fsBold in Font.Style, fsItalic in Font.Style ); 
    ctx.page.AddWordW( Word, x, y ); 
end; 
 
procedure TPdfWriter.DrawImage(x, y, width, height: Integer; Image: TGraphic; Raster: Boolean ); 
begin 
    ctx.page.WriteImage( x,y,width,height,image,raster ); 
end; 
 
procedure TPdfWriter.SetLink(Target: String; Bounds: TRect); 
begin 
    ctx.SetLink( Target, Bounds ); 
end; 
 
procedure TPdfWriter.ResolveLink(Target: String; X, Y: Integer); 
begin 
    ctx.ResolveLink( Target, X, Y ); 
end; 
 
{ TQuickPdf } 
 
procedure TQuickPdf.GenerateToStream( stream: TStream ); 
var 
    pctx: TPdfContext; 
    page: TPdfPage; 
    table,tab: TRenderTable; 
    writer: TPdfWriter; 
    keyLen: Integer; 
    acl: Cardinal; 
    savePages: TObjectList; 
    i: Integer; 
 
procedure AddContents( p: TQuickPdfContentsItem; lvl: Integer ); 
var 
    i: Integer; 
begin 
    if lvl >= 0 then 
        pctx.AddContentsLink( p.Title, p.Link, lvl ); 
    for i := 0 to Pred(p.Count) do 
        AddContents( p[i], lvl+1 ); 
end; 
 
{$IFDEF TRIAL} 
function IsIDERuning: Boolean; 
begin 
  Result := (FindWindow('TAppBuilder', nil) <> 0) or 
            (FindWindow('TPropertyInspector', nil) <> 0) or 
            (FindWindow('TAlignPalette', nil) <> 0); 
end; 
{$ENDIF} 
 
begin 
{$IFDEF TRIAL} 
    if not IsIDERuning then 
        ShowAboutForm( 'EMS QuickPdf Component Suite', VERSION, 'April', '2004' ); 
{$ENDIF} 
    Document.Section[0]; 
    case FSecurity of 
        sec40Bit: keyLen := 40; 
        sec128Bit: keyLen := 128; 
        else keyLen := 0; 
        end; 
    acl := $7FFFF0C0; 
    if secPrint in FSecurityOptions then acl := acl or $804; 
    if secExtraction in FSecurityOptions then acl := acl or $210; 
    if secModify in FSecurityOptions then acl := acl or $528; 
    pctx := TPdfContext.Create( stream, PageInfo.Width * 720 div 254, PageInfo.Height * 720 div 254, keyLen, acl, FOwnerPassword, FUserPassword ); 
    writer := TPdfWriter.Create(pctx); 
    AddContents( Contents, -1 ); 
    pctx.SetDocInfo( 'EMS QuickPdf '+VERSION, FCreator,FTitle,FAuthor,FSubject,FKeywords ); 
    Contents.Clear; 
    Table := FDocument.FTable; 
    FDocument.FTable := nil; 
    savePages := TObjectList.Create; 
    savePages.OwnsObjects := False; 
    try 
        While Assigned(Table) do begin 
            tab := Table.Split( PageInfo.Height * 720 div 254, splitForced ) as TRenderTable; 
            savePages.Add( Table ); 
            Table := tab; 
            end; 
        Writer.TotalPages := savePages.Count; 
        for i := 0 to Pred(savePages.Count) do begin 
            Writer.CurPageNum := i + 1; 
            tab := savePages[i] as TRenderTable; 
            page := pctx.AddPage; 
            tab.AdjustFooter( page.PageHeight ); 
            tab.Draw( Writer, 0, 0 ); 
            tab.Free; 
            end; 
        pctx.Generate( FEmbedded ); 
    finally 
        writer.Free; 
        pctx.Free; 
        savePages.Free; 
    end; 
end; 
 
procedure TQuickPdf.GenerateToFile; 
var 
    f: TFileStream; 
begin 
    if FFileName = '' then 
        raise Exception.Create( 'FileName property is not assigned' ); 
    f := TFileStream.Create( FFileName, fmCreate ); 
    try 
        GenerateToStream( f ); 
    finally 
        f.Free; 
    end; 
end; 
 
function TQuickPdf.GenerateToString: String; 
var 
    s: TStringStream; 
begin 
    Result := ''; 
    s := TStringStream.Create( '' ); 
    try 
        GenerateToStream( s ); 
        Result := s.DataString; 
    finally 
        s.Free; 
    end; 
 
end; 
 
 
constructor TQuickPdf.Create(AOwner: TComponent); 
begin 
    inherited; 
    FEmbedded := True; 
    FDocument := TQuickPdfDocument.Create; 
    FContents := TQuickPdfContentsItem.Create; 
    FPageInfo := TQuickPdfPageInfo.Create; 
end; 
 
destructor TQuickPdf.Destroy; 
begin 
    inherited; 
    FDocument.Free; 
    FContents.Free; 
    FPageInfo.Free; 
end; 
 
procedure TQuickPdf.Clear; 
begin 
    Document.Clear; 
    Contents.Clear; 
end; 
 
function TQuickPdf.GetDocument: TQuickPdfDocument; 
begin 
    if (FDocument.FTable = nil) or (FDocument.FWidth <> PageInfo.Width ) then 
        FDocument.Start( PageInfo ); 
    Result := FDocument; 
end; 
 
{ TQuickPdfDocument } 
 
constructor TQuickPdfDocument.Create; 
begin 
    FTable := nil; 
end; 
 
destructor TQuickPdfDocument.Destroy; 
begin 
    inherited; 
    if ASsigned(FTable) then 
        FTable.Free; 
end; 
 
procedure TQuickPdfDocument.Clear; 
begin 
    if Assigned(FTable) then 
        FTable.Free; 
    FTable := nil; 
end; 
 
procedure TQuickPdfDocument.Start( page: TQuickPdfPageInfo ); 
begin 
    Clear; 
    FWidth := page.Width; 
    FTable := TRenderTable.Create( [page.Width * 720 div 254] ); 
    FTable.Padding.Left := page.MarginLeft * 720 div 254; 
    FTable.Padding.Right := page.MarginRight * 720 div 254; 
    FTable.Padding.Top := page.MarginTop * 720 div 254; 
    FTable.Padding.Bottom := page.MarginBottom * 720 div 254; 
    FTable.Border := -1; 
    FTable.AddRow; 
    FTable.AddRow; 
    FTable.AddRow; 
    FTable.HasHeader := True; 
    FTable.HasFooter := True; 
end; 
 
function TQuickPdfDocument.GetSection(Index: Integer): TRenderCell; 
begin 
    MainTable.ForceRows( Index ); 
    Result := MainTable[0,Index+1]; 
end; 
 
function TQuickPdfDocument.GetFooter: TRenderCell; 
begin 
    Result := MainTable.LastRow.Cell[0]; 
end; 
 
function TQuickPdfDocument.GetHeader: TRenderCell; 
begin 
    Result := MainTable[0,0]; 
end; 
 
procedure TQuickPdfDocument.SetMargins(left, top, right, bottom: Integer); 
begin 
    MainTable.Padding := Rect(left,top,right,bottom); 
end; 
 
{ TQuickPdfContentsItem } 
 
function TQuickPdfContentsItem.Add(ATitle, ALink: String): TQuickPdfContentsItem; 
begin 
    Result := TQuickPdfContentsItem.Create( ATitle, ALink, Self ); 
    FItems.Add( Result ); 
end; 
 
constructor TQuickPdfContentsItem.Create; 
begin 
    FItems := TObjectList.Create; 
    FParent := nil; 
end; 
 
procedure TQuickPdfContentsItem.Clear; 
begin 
    FItems.Free; 
    FItems := TObjectList.Create; 
end; 
 
constructor TQuickPdfContentsItem.Create(ATitle, ALink: String; AParent: TQuickPdfContentsItem); 
begin 
    Create; 
    Title := ATitle; 
    Link := ALink; 
    Parent := AParent; 
end; 
 
destructor TQuickPdfContentsItem.Destroy; 
begin 
    inherited; 
    FItems.Free; 
end; 
 
function TQuickPdfContentsItem.GetCounter: Integer; 
begin 
    Result := FItems.Count; 
end; 
 
function TQuickPdfContentsItem.GetItem(Index: Integer): TQuickPdfContentsItem; 
begin 
    Result := FItems[Index] as TQuickPdfContentsItem; 
end; 
 
 
{ TQuickPdfPageInfo } 
 
constructor TQuickPdfPageInfo.Create; 
begin 
    Size := psA4; 
    MarginLeft := 5; 
    MarginRight := 5; 
    MarginTop := 5; 
    MarginBottom := 5; 
end; 
 
procedure TQuickPdfPageInfo.SetSize(const Value: TQuickPdfPageSize); 
begin 
    if FSize <> Value then begin 
        case Value of 
            psA4: begin Width := 210; Height := 297; end; 
            psLetter: begin Width := 216; Height := 279; end; 
            psLegal: begin Width := 216; Height := 356; end; 
            end; 
        FSize := Value; 
        end; 
end; 
 
procedure TQuickPdfPageInfo.SetHeight(Value: Integer); 
begin 
    if Value < 10 then Value := 10; 
    if FHeight <> Value then begin 
        FSize := psCustom; 
        FHeight := Value; 
        MarginTop := MarginTop; 
        MarginBottom := MarginBottom; 
        end; 
end; 
 
procedure TQuickPdfPageInfo.SetWidth(Value: Integer); 
begin 
    if Value < 10 then Value := 10; 
    if FWidth <> Value then begin 
        FSize := psCustom; 
        FWidth := Value; 
        MarginRight := MarginRight; 
        MarginLeft := MarginLeft; 
        end; 
end; 
 
 
procedure TQuickPdfPageInfo.SetMarginTop(Value: Integer); 
begin 
    if Value > Height - MarginBottom - 10 then 
        Value := Height - MarginBottom - 10; 
    if Value < 0 then Value := 0; 
    FMarginTop := Value; 
end; 
 
procedure TQuickPdfPageInfo.SetMarginBottom(Value: Integer); 
begin 
    if Value > Height - MarginTop - 10 then 
        Value := Height - MarginTop - 10; 
    if Value < 0 then Value := 0; 
    FMarginBottom := Value; 
end; 
 
procedure TQuickPdfPageInfo.SetMarginLeft(Value: Integer); 
begin 
    if Value > Width - MarginRight - 10 then 
        Value := Width - MarginRight - 10; 
    if Value < 0 then Value := 0; 
    FMarginLeft := Value; 
end; 
 
procedure TQuickPdfPageInfo.SetMarginRight(Value: Integer); 
begin 
    if Value > Width - MarginLeft - 10 then 
        Value := Width - MarginLeft - 10; 
    if Value < 0 then Value := 0; 
    FMarginRight := Value; 
end; 
 
procedure TQuickPdfPageInfo.AssignTo(Dest: TPersistent); 
begin 
    if Dest is TQuickPdfPageInfo then with TQuickPdfPageInfo(Dest) do begin 
        FSize := Self.FSize; 
        FWidth := Self.FWidth; 
        FHeight := Self.FHeight; 
        FMarginLeft := Self.FMarginLeft; 
        FMarginRight := Self.FMarginRight; 
        FMarginTop := Self.FMarginTop; 
        FMarginBottom := Self.FMarginBottom; 
        end 
    else 
        inherited; 
end; 
 
end.