preport.pas

给PDF文件加盖印章或背景

    property Prev: TPROutlineEntry read GetPrev;
    property First: TPROutlineEntry read GetFirst;
    property Last: TPROutlineEntry read GetLast;
    property Dest: TPRDestination read GetDest write SetDest;
    property Title: string read GetTitle write SetTitle;
    property Opened: boolean read GetOpened write SetOpened;
  end;

  { TPROutlineRoot }
  TPROutlineRoot = class(TPROutlineEntry)
  protected
    constructor CreateRoot(ADoc: TPdfDoc);
  end;


const
  LINE_PITCH: integer = 378;
  LINE_COLOR: TColor = clSilver;
  DEFAULT_MARGIN = 32;
  PROTECT_AREA_COLOR: TColor = $00EFEFEF;
  MIN_PANEL_SIZE = 10;
  MAX_IMAGE_NUMBER = 65535;
{$IFDEF USE_JPFONTS}
  PDFFONT_CLASS_NAMES: array[0..6] of string = (
                           'FixedWidth',
                           'Arial',
                           'Times-Roman',
                           'Gothic',
                           'Mincyo',
                           'PGothic',
                           'PMincyo');
  PDFFONT_CLASS_BOLD_NAMES: array[0..6] of string = (
                           'FixedWidth-Bold',
                           'Arial-Bold',
                           'Times-Bold',
                           'Gothic,Bold',
                           'Mincyo,Bold',
                           'PGothic,Bold',
                           'PMincyo,Bold');
  PDFFONT_CLASS_ITALIC_NAMES: array[0..6] of string = (
                           'FixedWidth-Italic',
                           'Arial-Italic',
                           'Times-Italic',
                           'Gothic,Italic',
                           'Mincyo,Italic',
                           'PGothic,Italic',
                           'PMincyo,Italic');
  PDFFONT_CLASS_BOLDITALIC_NAMES: array[0..6] of string = (
                           'FixedWidth-BoldItalic',
                           'Arial-BoldItalic',
                           'Times-BoldItalic',
                           'Gothic,BoldItalic',
                           'Mincyo,BoldItalic',
                           'PGothic,BoldItalic',
                           'PMincyo');
  ITEM_FONT_NAMES: array[0..6] of string = (
                           'Courier New',
                           'Arial',
                           'Times New Roman',
                           #130#108#130#114#32#131#83#131#86#131#98#131#78,
                           #130#108#130#114#32#150#190#146#169,
                           #130#108#130#114#32#130#111#131#83#131#86#131#98#131#78,
                           #130#108#130#114#32#130#111#150#190#146#169);
  ITEM_FONT_CHARSETS: array[0..6] of TFontCharset = (
                           ANSI_CHARSET,
                           ANSI_CHARSET,
                           ANSI_CHARSET,
                           SHIFTJIS_CHARSET,
                           SHIFTJIS_CHARSET,
                           SHIFTJIS_CHARSET,
                           SHIFTJIS_CHARSET);
{$ELSE}
{$IFDEF USE_GBFONTS}
  PDFFONT_CLASS_NAMES: array[0..3] of string = (
                           'FixedWidth',
                           'Arial',
                           'Times-Roman',
                           'Chinese');
  PDFFONT_CLASS_BOLD_NAMES: array[0..3] of string = (
                           'FixedWidth-Bold',
                           'Arial-Bold',
                           'Times-Bold',
                           'Chinese');
  PDFFONT_CLASS_ITALIC_NAMES: array[0..3] of string = (
                           'FixedWidth-Italic',
                           'Arial-Italic',
                           'Times-Italic',
                           'Chinese');
  PDFFONT_CLASS_BOLDITALIC_NAMES: array[0..3] of string = (
                           'FixedWidth-BoldItalic',
                           'Arial-BoldItalic',
                           'Times-BoldItalic',
                           'Chinese');
  ITEM_FONT_NAMES: array[0..3] of string = (
                           'Courier New',
                           'Arial',
                           'TimesNewRoman',
                           'Chinese');
  ITEM_FONT_CHARSETS: array[0..3] of TFontCharset = (
                           ANSI_CHARSET,
                           ANSI_CHARSET,
                           ANSI_CHARSET,
                           GB2312_CHARSET);
{$ELSE}
  PDFFONT_CLASS_NAMES: array[0..2] of string = (
                           'FixedWidth',
                           'Arial',
                           'Times-Roman');
  PDFFONT_CLASS_BOLD_NAMES: array[0..2] of string = (
                           'FixedWidth-Bold',
                           'Arial-Bold',
                           'Times-Bold');
  PDFFONT_CLASS_ITALIC_NAMES: array[0..2] of string = (
                           'FixedWidth-Italic',
                           'Arial-Italic',
                           'Times-Italic');
  PDFFONT_CLASS_BOLDITALIC_NAMES: array[0..2] of string = (
                           'FixedWidth-BoldItalic',
                           'Arial-BoldItalic',
                           'Times-BoldItalic');
  ITEM_FONT_NAMES: array[0..2] of string = (
                           'Courier New',
                           'Arial',
                           'Times New Roman');
  ITEM_FONT_CHARSETS: array[0..2] of TFontCharset = (
                           ANSI_CHARSET,
                           ANSI_CHARSET,
                           ANSI_CHARSET);
{$ENDIF}
{$ENDIF}

implementation

{ common routines }

procedure PaintGrid(Canvas: TCanvas; Width, Height: integer;
  OffsetX, OffsetY: integer);
var
  LinePos: integer;
  LineCount: integer;
  LineFlg: boolean;

  // sub routine to set pen style
  procedure SetPen(Canvas: TCanvas; flg: boolean);
  begin
    Canvas.Pen.Color := LINE_COLOR;
    if flg then
      Canvas.Pen.Style := psSolid
    else
      Canvas.Pen.Style := psDot;
  end;

begin
  with Canvas do
  begin
    // drawing vertical lines.
    LineCount := 0;
    LineFlg := true;
    LinePos := - OffsetX;
    while LinePos < Width do
    begin
      if LinePos > 0 then
      begin
        MoveTo(LinePos, 0);
        SetPen(Canvas, LineFlg);
        LineTo(LinePos, Height - 1);
      end;
      inc(LineCount);
      LineFlg := not LineFlg;
      LinePos := trunc(LineCount * LINE_PITCH / 20) - OffsetX;
    end;

    // drawing horizontal lines.
    LineCount := 0;
    LineFlg := true;
    LinePos := - OffsetY;
    while LinePos < Height do
    begin
      if LinePos > 0 then
      begin
        MoveTo(0, LinePos);
        SetPen(Canvas, LineFlg);
        LineTo(Width - 1, LinePos);
      end;
      inc(LineCount);
      LineFlg := not LineFlg;
      LinePos := trunc(LineCount * LINE_PITCH / 20) - OffsetY;
    end;
  end;
end;

{ TPReport }

// Create
constructor TPReport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFileName := 'default.pdf';
  FCreationDate := now;
  FDoc := nil;
  FCanvas := TPRCanvas.Create;
end;

// Destroy
destructor TPReport.Destroy;
begin
  FCanvas.Free;
  if FDoc <> nil then Abort;
  inherited;
end;

// BeginDoc
procedure TPReport.BeginDoc;
begin
  if FDoc <> nil then Abort;
  FDoc := TPdfDoc.Create;
  with FDoc do
  begin
    UseOutlines := Self.UseOutlines;
    CompressionMethod := FCompressionMethod;
    NewDoc;
    if UseOutlines then
      FOutlineRoot := TPROutlineRoot.CreateRoot(FDoc);
    Root.PageMode := PageMode;
    Root.PageLayout := PageLayout;
    if NonFullScreenPageMode <> pmUseNone then
      Root.NonFullScreenPageMode := NonFullScreenPageMode;
    if ViewerPreference <> [] then
      Root.ViewerPreference := ViewerPreference;
    Info.Author := Author;
    Info.CreationDate := CreationDate;
    Info.Creator := Creator;
    Info.Keywords := Keywords;
    Info.ModDate := ModDate;
    Info.Subject := Subject;
    Info.Title := Title;
  end;
  FPage := 0;
end;

// Print
procedure TPReport.Print(APage: TPRPage);
begin
  FDoc.AddPage;
  inc(FPage);
  FCanvas.PdfCanvas := FDoc.Canvas;
  APage.Print(FCanvas);
end;

// EndDoc
procedure TPReport.EndDoc;
var
  FStream: TStream;
begin
  if FDoc <> nil then
  begin
    FStream := TFileStream.Create(FFileName, fmCreate);
    FDoc.SaveToStream(FStream);
    FStream.Free;
    FDoc.Free;
    FDoc := nil;
    FOutlineRoot := nil;
  end
  else
    raise EInvalidOperation.Create('document is null..');
end;

// Abort
procedure TPReport.Abort;
begin
  if FDoc <> nil then
  begin
    FDoc.Free;
    FDoc := nil;
    FOutlineRoot := nil;
  end
end;

// SetOpenAction
procedure TPReport.SetOpenAction(ADest: TPRDestination);
begin
  if (FDoc = nil) or not (FDoc.HasDoc) then
    raise EPdfInvalidOperation.Create('SetOpenAction --invalid operation.')
  else
  begin
    FDoc.Root.OpenAction := ADest.FData;
    FOpenAction := ADest;
  end;
end;

// SetAuthor
procedure TPReport.SetAuthor(Value: string);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetAuthor --invalid operation.');
  FAuthor := Value;
end;

// SetCreationDate
procedure TPReport.SetCreationDate(Value: TDateTime);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetCreationDate --invalid operation.');
  FCreationDate := Value;
end;

// SetCreator
procedure TPReport.SetCreator(Value: string);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetCreator --invalid operation.');
  FCreator := Value;
end;

// SetKeyWords
procedure TPReport.SetKeyWords(Value: string);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetKeyWords --invalid operation.');
  FKeyWords := Value;
end;

// SetModDate
procedure TPReport.SetModDate(Value: TDateTime);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetModDate --invalid operation.');
  FModDate := Value;
end;

// SetSubject
procedure TPReport.SetSubject(Value: string);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetSubject --invalid operation.');
  FSubject := Value;
end;

// SetTitle
procedure TPReport.SetTitle(Value: string);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetTitle --invalid operation.');
  FTitle := Value;
end;

// SetPageLayout
procedure TPReport.SetPageLayout(Value: TPRPageLayout);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetPageLayout --invalid operation.');
  FPageLayout := Value;
end;

// SetPageMode
procedure TPReport.SetPageMode(Value: TPRPageMode);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetPageMode --invalid operation.');
  FPageMode := Value;
end;

// SetNonFullScreenPageMode
procedure TPReport.SetNonFullScreenPageMode(Value: TPRPageMode);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetNonFullScreenPageMode --invalid operation.');
  if Value = pmFullScreen then
    FNonFullScreenPageMode := pmUseNone
  else
    FNonFullScreenPageMode := Value;
end;

// SetUseOutlines
procedure TPReport.SetUseOutlines(Value: boolean);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetUseOutlines --invalid operation.');
  FUseOutlines := Value;
end;

// SetViewerPreference
procedure TPReport.SetViewerPreference(Value: TPRViewerPreferences);
begin
  if FDoc <> nil then
    raise EPdfInvalidOperation.Create('SetViewerPreference --invalid operation.');
  FViewerPreference := Value;
end;

// GetOpenAction
function TPReport.GetOpenAction: TPRDestination;
begin
  if (FDoc = nil) or not (FDoc.HasDoc) then
    raise EPdfInvalidOperation.Create('GetOpenAction --invalid operation.')
  else
    result := FOpenAction;
end;

// GetPdfDoc
function TPReport.GetPdfDoc: TPdfDoc;
begin
  result := FDoc;
end;

// GetOutlineRoot
function TPReport.GetOutlineRoot: TPROutlineRoot;
begin
  if (FDoc = nil) or not (FDoc.HasDoc) or not (FUseOutlines) then
    raise EPdfInvalidOperation.Create('GetOutlineRoot --invalid operation.')
  else
    result := FOutlineRoot;
end;

// CreateDestination
function TPReport.CreateDestination: TPRDestination;
begin
  if (FDoc = nil) or not (FDoc.HasDoc) then
    raise EPdfInvalidOperation.Create('CreateDestination --invalid operation.')
  else
  begin
    result := TPRDestination.Create(FDoc.CreateDestination);
    result.Top := -10;
    result.Zoom := 1;
  end;
end;

{ TPRCanvas }

// Create
constructor TPRCanvas.Create;
begin
  inherited;
  FCanvas := nil;
end;

// SetPdfCanvas
procedure TPRCanvas.SetPdfCanvas(ACanvas: TPdfCanvas);
begin
  FCanvas := ACanvas;
end;

// GetPageHeight
function TPRCanvas.GetPageHeight: integer;
begin
  result := PdfCanvas.PageHeight;
end;

// GetPageWidth
function TPRCanvas.GetPageWidth: integer;
begin
  result := PdfCanvas.PageWidth;
end;

// SetCharSpace
procedure TPRCanvas.SetCharSpace(charSpace: Single);
begin
  PdfCanvas.SetCharSpace(charSpace);
end;

// SetWordSpace
procedure TPRCanvas.SetWordSpace(wordSpace: Single);
begin
  PdfCanvas.SetWordSpace(wordSpace);
end;

// SetHorizontalScaling
procedure TPRCanvas.SetHorizontalScaling(hScaling: Word);
begin
  PdfCanvas.SetHorizontalScaling(hScaling);
end;

// SetLeading
procedure TPRCanvas.SetLeading(leading: Single);
begin
  PdfCanvas.SetLeading(leading);
end;

// SetFont
procedure TPRCanvas.SetFont(fontname: string; size: Single);
begin
  PdfCanvas.SetFont(fontname, size);
end;

// SetTextRenderingMode
procedure TPRCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
begin
  PdfCanvas.SetTextRenderingMode(mode);