pdfdoc.pas

给PDF文件加盖印章或背景

  if (Parent <> nil) and (_GetTypeOf(Parent) = 'Pages') then
    _Pages_AddKids(Parent, Result)
  else
    FRoot.Pages := Result;
end;

// CreateOutlines
procedure TPdfDoc.CreateOutlines;
begin
  FOutlineRoot := TPdfOutlineRoot.CreateRoot(Self);
  FRoot.Data.AddItem('Outlines', FOutlineRoot.Data);
end;

// GetFont
function TPdfDoc.GetFont(FontName: string): TPdfFont;
var
  FFont: TPdfFont;
  i :integer;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('GetFont --document is null.');

  // if specified font exists in fontlist, return it. otherwise, create the font.
  Result := nil;
  for i := 0 to FFontList.Count - 1 do
  begin
    FFont := TPdfFont(FFontList.Items[i]);
    if FFont.Name = FontName then
    begin
      Result := FFont;
      Break;
    end;
  end;
  if Result = nil then
    Result := CreateFont(FontName);
end;

// GetXObject
function TPdfDoc.GetXObject(AName: string): TPdfXObject;
var
  FXObject: TPdfXObject;
  i :integer;
begin
  // return the XObject which name is muched with specified name.
  Result := nil;
  for i := 0 to FXObjectList.ItemCount - 1 do
  begin
    FXObject := TPdfXObject(FXObjectList.Items[i]);
    if TPdfName(FXObject.Attributes.ValueByName('Name')).Value = AName then
    begin
      Result := FXObject;
      Break;
    end;
  end;
end;

// CreateAnnotation
function TPdfDoc.CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
var
  FAnnotation: TPdfDictionary;
  FArray: TPdfArray;
  FPage: TPdfDictionary;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('AddAnotation --document is null.');

  // create new annotation and set the properties.
  FAnnotation := TPdfDictionary.CreateDictionary(FXref);
  FXref.AddObject(FAnnotation);
  with FAnnotation do
  begin
    AddItem('Type', TPdfName.CreateName('Annot'));
    AddItem('Subtype', TPdfName.CreateName(PDF_ANNOTATION_TYPE_NAMES[ord(AType)]));
    FArray := TPdfArray.CreateArray(nil);
    with FArray, ARect do
    begin
      AddItem(TPdfReal.CreateReal(Left));
      AddItem(TPdfReal.CreateReal(Top));
      AddItem(TPdfReal.CreateReal(Right));
      AddItem(TPdfReal.CreateReal(Bottom));
    end;
    AddItem('Rect', FArray);
  end;

  // adding annotation to the current page
  FPage := FCanvas.Page;
  FArray := FPage.PdfArrayByName('Annots');
  if FArray = nil then
  begin
    FArray := TPdfArray.CreateArray(nil);
    FPage.AddItem('Annots', FArray);
  end;
  FArray.AddItem(FAnnotation);

  Result := FAnnotation;
end;

// CreateDestination
function TPdfDoc.CreateDestination: TPdfDestination;
begin
  Result := TPdfDestination.Create(Self);
  FObjectList.Add(Result);
end;

// NewDoc
procedure TPdfDoc.NewDoc;
begin
  {*
   * create new document.
   *}
  FreeDoc;
  FXref := TPdfXref.Create;
  FHeader := TPdfHeader.Create;
  FTrailer := TPdfTrailer.Create(FXref);
  FFontList := TList.Create;
  FXObjectList := TPdfArray.CreateArray(FXref);
  FObjectList := TList.Create;

  FRoot := TPdfCatalog.Create;
  FRoot.SetData(CreateCatalog);
  FObjectList.Add(FRoot);

  if UseOutlines then
    CreateOutlines;

  CreateInfo;
  FInfo.CreationDate := now;

  FCurrentPages := CreatePages(nil);
  FRoot.SetPages(FCurrentPages);

  FHasDoc := true;
end;

// AddXObject
procedure TPdfDoc.AddXObject(AName: string; AXObject: TPdfXObject);
begin
  if GetXObject(AName) <> nil then
    raise Exception.CreateFmt('AddImage --the image named %s is already exists..', [AName]);

  // check whether AImage is valid PdfImage or not.
  if (AXObject = nil) or (AXObject.Attributes = nil) or
    (_GetTypeOf(AXObject.Attributes) <> 'XObject') or
    (AXObject.Attributes.PdfNameByName('Subtype').Value <> 'Image') then
    raise Exception.Create('AddImage --the image is not valid TPdfImage..');

  FXref.AddObject(AXObject);
  RegisterXObject(AXObject, AName);
end;

// AddPage
procedure TPdfDoc.AddPage;
var
  FPage: TPdfDictionary;
  FMediaBox: TPdfArray;
  FContents: TPdfStream;
  FResources: TPdfDictionary;
  FProcSet: TPdfArray;
  FFontArray: TPdfDictionary;
  FXObjectArray: TPdfDictionary;
  {$IFNDEF NOZLIB}
  FFilter: TPdfArray;
  {$ENDIF}
begin
  if FCurrentPages = nil then
    raise EPdfInvalidOperation.Create('AddPage --current pages null.');

  // create new page object and add it to the current pages object.
  FPage := TPdfDictionary.CreateDictionary(FXref);
  FXref.AddObject(FPage);

  _Pages_AddKids(FCurrentPages, FPage);

  FPage.AddItem('Type', TPdfName.CreateName('Page'));
  FPage.AddItem('Parent', FCurrentPages);

  FMediaBox := TPdfArray.CreateArray(FXref);
  with FMediabox do
  begin
    AddItem(TPdfNumber.CreateNumber(0));
    AddItem(TPdfNumber.CreateNumber(0));
    AddItem(TPdfNumber.CreateNumber(DefaultPageWidth));
    AddItem(TPdfNumber.CreateNumber(DefaultPageHeight));
  end;
  FPage.AddItem('MediaBox', FMediaBox);

  FResources := TPdfDictionary.CreateDictionary(FXref);
  FPage.AddItem('Resources', FResources);

  FFontArray := TPdfDictionary.CreateDictionary(FXref);
  FResources.AddItem('Font', FFontArray);

  FXObjectArray := TPdfDictionary.CreateDictionary(FXref);
  FResources.AddItem('XObject', FXObjectArray);

  FProcSet := TPdfArray.CreateArray(FXref);
  with FProcSet do
  begin
    AddItem(TPdfName.CreateName('PDF'));
    AddItem(TPdfName.CreateName('Text'));
    AddItem(TPdfName.CreateName('ImageC'));
  end;
  FResources.AddItem('ProcSet', FProcSet);

  FContents := TPdfStream.CreateStream(FXref);
  FXref.AddObject(FContents);
  {$IFNDEF NOZLIB}
  FFilter := FContents.Attributes.PdfArrayByName('Filter');
  if FCompressionMethod = cmFlateDecode then
    FFilter.AddItem(TPdfName.CreateName('FlateDecode'));
  {$ENDIF}
  FPage.AddItem('Contents', FContents);

  FCanvas.SetPage(FPage);
end;

// FreeDoc
procedure TPdfDoc.FreeDoc;
var
  i: integer;
begin
  if FHasDoc then
  begin
    FXObjectList.Free;

    for i := FFontList.Count - 1 downto 0 do
      TObject(FFontList.Items[i]).Free;
    FFontList.Free;

    for i := FObjectList.Count - 1 downto 0 do
      TObject(FObjectList.Items[i]).Free;
    FObjectList.Free;

    FXref.Free;
    FHeader.Free;
    FTrailer.Free;

    FInfo := nil;
    FRoot := nil;
    FOutlineRoot := nil;

    FHasDoc := false;
  end;
end;

// SaveToStream
procedure TPdfDoc.SaveToStream(AStream: TStream);
var
  i: integer;
  Pos: integer;
  PdfNumber: TPdfNumber;
begin
  if not HasDoc or (FCanvas.Page = nil) then
    raise EPdfInvalidOperation.Create('SaveToStream --there is no document to save.');
  // write all objects to specified stream.

  FInfo.ModDate := Now;
  FRoot.SaveOpenAction;

  // saving outline tree.
  if UseOutlines then
    FOutlineRoot.Save;

  AStream.Position := 0;
  FHeader.WriteToStream(AStream);
  for i := 1 to FXref.ItemCount - 1 do
  begin
    Pos := AStream.Position;
    FXref.Items[i].Value.WriteValueToStream(AStream);
    FXref.Items[i].ByteOffset := Pos;
  end;
  FTrailer.XrefAddress := AStream.Position;
  FXref.WriteToStream(AStream);
  PdfNumber := FTrailer.Attributes.PdfNumberByName('Size');
  PdfNumber.Value := FXref.ItemCount;
  FTrailer.WriteToStream(AStream);
end;

// SetVirtualMode
procedure TPdfDoc.SetVirtualMode;
begin
  NewDoc;
  AddPage;
  FCanvas.FIsVirtual := true;
end;


{ TPdfCanvasAttribute }

// SetWordSpace
procedure TPdfCanvasAttribute.SetWordSpace(Value: Single);
begin
  if Value < 0 then
    raise EPdfInvalidValue.Create('SetWordSpace --invalid word space');
  if Value <> FWordSpace then
    FWordSpace := Value;
end;

// SetCharSpace
procedure TPdfCanvasAttribute.SetCharSpace(Value: Single);
begin
  if (Value < PDF_MIN_CHARSPACE) or (VALUE > PDF_MAX_CHARSPACE) then
    raise EPdfInvalidValue.Create('SetCharSpace --invalid char space');
  if Value <> FCharSpace then
    FCharSpace := Value;
end;

// SetFontSize
procedure TPdfCanvasAttribute.SetFontSize(Value: Single);
begin
  if (Value < 0) or (Value > PDF_MAX_FONTSIZE) then
    raise EPdfInvalidValue.Create('SetCharSpace --invalid font size');
  if Value <> FFontSize then
    FFontSize := Value;
end;

// SetHorizontalScaling
procedure TPdfCanvasAttribute.SetHorizontalScaling(Value: Word);
begin
  if (Value < PDF_MIN_HORIZONTALSCALING) or
    (Value > PDF_MAX_HORIZONTALSCALING) then
    raise EPdfInvalidValue.Create('SetHorizontalScaling --invalid font size');
  if Value <> FHorizontalScaling then
    FHorizontalScaling := Value;
end;

// SetLeading
procedure TPdfCanvasAttribute.SetLeading(Value: Single);
begin
  if (Value < 0) or (Value > PDF_MAX_LEADING) then
    raise EPdfInvalidValue.Create('SetLeading --invalid font size');
  if Value <> FLeading then
    FLeading := Value;
end;

// TextWidth
function TPdfCanvasAttribute.TextWidth(Text: string): Single;
var
  i: integer;
  ch: char;
  tmpWidth: Single;
begin
  Result := 0;

  // calculate width of specified text from current attributes
  for i := 1 to Length(Text) do
  begin
    ch := Text[i];
    tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
    if FHorizontalScaling <> 100 then
      tmpWidth := tmpWidth * FHorizontalScaling / 100;
    if tmpWidth > 0 then
      tmpWidth := tmpWidth + FCharSpace
    else
      tmpWidth := 0;
    if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
      tmpWidth := tmpWidth + FWordSpace;

    Result := Result + tmpWidth;
  end;
  Result := Result - FCharSpace;
end;

// MeasureText
function TPdfCanvasAttribute.MeasureText(Text: string; Width: Single): integer;
var
  i: integer;
  ch: char;
  tmpWidth: Single;
  tmpTotalWidth: Single;
begin
  Result := 0;
  tmpTotalWidth := 0;

  // calculate number of charactor contain in the specified width.
  for i := 1 to Length(Text) do
  begin
    ch := Text[i];
    tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
    if FHorizontalScaling <> 100 then
      tmpWidth := tmpWidth * FHorizontalScaling / 100;
    if tmpWidth > 0 then
      tmpWidth := tmpWidth + FCharSpace
    else
      tmpWidth := 0;
    if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
      tmpWidth := tmpWidth + FWordSpace;

    tmpTotalWidth := tmpTotalWidth + tmpWidth;
    if tmpTotalWidth > Width then
      Break;
    inc(Result);
  end;
  //Result:=tmpTotalWidth;//zhan 2008-5-29 这里需要修改;
end;

{ TPdfCanvas }

// Create
constructor TPdfCanvas.Create(APdfDoc: TPdfDoc);
begin
  FPdfDoc := APdfDoc;
  FPage := nil;
  FContents := nil;
  FAttr := TPdfCanvasAttribute.Create;
  FIsVirtual := false;
end;

// Destroy
destructor TPdfCanvas.Destroy;
begin
  FAttr.Free;
  inherited;
end;

// SetPageWidth
procedure TPdfCanvas.SetPageWidth(AValue: integer);
var
  FMediaBox: TPdfArray;
begin
  FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  if FMediaBox <> nil then
    TPdfNumber(FMediaBox.Items[2]).Value := AValue
  else
    EPdfInvalidOperation.Create('Can not chenge width of this page..');
end;

// SetPageHeight
procedure TPdfCanvas.SetPageHeight(AValue: integer);
var
  FMediaBox: TPdfArray;
begin
  FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  if FMediaBox <> nil then
    TPdfNumber(FMediaBox.Items[3]).Value := AValue
  else
    EPdfInvalidOperation.Create('Can not chenge width of this page..');
end;

// WriteString
procedure TPdfCanvas.WriteString(S: string);
begin
  if (not FIsVirtual) and (FContents <> nil) then
    _WriteString(S, FContents.Stream);
end;

// GetPage
function TPdfCanvas.GetPage: TPdfDictionary;
begin
 // if FPage <> nil then
    result := FPage
 // else
 //   raise EPdfInvalidOperation.Create('GetPage --the Page is nil');
end;

// GetPageWidth
function TPdfCanvas.GetPageWidth: Integer;
var
  FMediaBox: TPdfArray;
begin
  FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  if FMediaBox <> nil then
    result := TPdfNumber(FMediaBox.Items[2]).Value
  else
    result := FPdfDoc.DefaultPageWidth;
end;

// GetPageHeight