pdfdoc.pas

给PDF文件加盖印章或背景

// EofillStroke
procedure TPdfCanvas.EofillStroke;
begin
  WriteString('B*'#10);
end;

// ClosepathEofillStroke
procedure TPdfCanvas.ClosepathEofillStroke;
begin
  WriteString('b*'#10);
end;

// Clip
procedure TPdfCanvas.Clip;
begin
  WriteString('W'#10);
end;

// Eoclip
procedure TPdfCanvas.Eoclip;
begin
  WriteString('W*'#10);
end;

{* Test state *}

// SetCharSpace
procedure TPdfCanvas.SetCharSpace(charSpace: Single);
begin
  if FAttr.CharSpace = charSpace then Exit;
  FAttr.SetCharSpace(charSpace);
  if Contents <> nil then
    WriteString(_FloatToStrR(charSpace) + ' Tc'#10);
end;

// SetWordSpace
procedure TPdfCanvas.SetWordSpace(wordSpace: Single);
begin
  if FAttr.WordSpace = wordSpace then Exit;
  FAttr.SetWordSpace(wordSpace);
  if Contents <> nil then
    WriteString(_FloatToStrR(wordSpace) + ' Tw'#10);
end;

// SetHorizontalScaling
procedure TPdfCanvas.SetHorizontalScaling(hScaling: Word);
begin
  if FAttr.HorizontalScaling = hScaling then Exit;
  FAttr.SetHorizontalScaling(hScaling);
  WriteString(IntToStr(hScaling) + ' Tz'#10);
end;

// SetLeading
procedure TPdfCanvas.SetLeading(leading: Single);
begin
  if FAttr.Leading = leading then Exit;
  FAttr.SetLeading(leading);
  WriteString(_FloatToStrR(leading) + ' TL'#10);
end;

// SetFontAndSize
procedure TPdfCanvas.SetFontAndSize(fontname: string; size: Single);
var
  S: string;
begin
  S := fontname + ' ' +
       _FloatToStrR(size) + ' Tf'#10;
  WriteString(S);
end;

// SetTextRenderingMode
procedure TPdfCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
begin
  WriteString(IntToStr(ord(mode)) + ' Tr'#10);
end;

// SetTextRise
procedure TPdfCanvas.SetTextRise(rise: Word);
begin
  WriteString(IntToStr(rise) + ' Ts'#10);
end;

// BeginText
procedure TPdfCanvas.BeginText;
begin
  WriteString('BT'#10);
end;

// EndText
procedure TPdfCanvas.EndText;
begin
  WriteString('ET'#10);
end;

// MoveTextPoint
procedure TPdfCanvas.MoveTextPoint(tx, ty: Single);
var
  S: string;
begin
  S := _FloatToStrR(tx) + ' ' +
       _FloatToStrR(ty) + ' Td'#10;
  WriteString(S);
end;

// SetTextMatrix
procedure TPdfCanvas.SetTextMatrix(a, b, c, d, x, y: Word);
var
  S: string;
begin
  S := IntToStr(a) + ' ' +
       IntToStr(b) + ' ' +
       IntToStr(c) + ' ' +
       IntToStr(d) + ' ' +
       IntToStr(x) + ' ' +
       IntToStr(y) + ' Tm'#10;
  WriteString(S);
end;

// MoveToNextLine
procedure TPdfCanvas.MoveToNextLine;
begin
  WriteString('T*'#10);
end;

// ShowText
procedure TPdfCanvas.ShowText(s: string);
var
  FString: string;
begin
  if _HasMultiByteString(s) then
    FString := '<' + _StrToHex(s) + '>'
  else
    FString := '(' + _EscapeText(s) + ')';
  WriteString(FString + ' Tj'#10);
end;

// ShowTextNextLine
procedure TPdfCanvas.ShowTextNextLine(s: string);
var
  FString: string;
begin
  if _HasMultiByteString(s) then
    FString := '<' + _StrToHex(s) + '>'
  else
    FString := '(' + _EscapeText(s) + ')';
  WriteString(FString + ' '''#10);
end;

{* external objects *}

// ExecuteXObject
procedure TPdfCanvas.ExecuteXObject(xObject: string);
var
  S: string;
begin
  S := '/' + xObject + ' Do'#10;
  WriteString(S);
end;

{* Device-dependent color space operators *}

// SetRGBFillColor
procedure TPdfCanvas.SetRGBFillColor(Value: TPdfColor);
var
  S: string;
begin
  S := GetColorStr(Value) + ' rg'#10;
  WriteString(S);
end;

// SetRGBStrokeColor
procedure TPdfCanvas.SetRGBStrokeColor(Value: TPdfColor);
var
  S: string;
begin
  S := GetColorStr(Value) + ' RG'#10;
  WriteString(S);
end;

{ TPdfCanvas common routine }

// TextWidth
function TPdfCanvas.TextWidth(Text: string): Single;
begin
  result := FAttr.TextWidth(Text);
end;

// MeasureText
function TPdfCanvas.MeasureText(Text: string; AWidth: Single): integer;
begin
  result := FAttr.MeasureText(Text, AWidth);
end;

// Ellipse
procedure TPdfCanvas.Ellipse(x, y, width, height: Single);
begin
    MoveTo(x, y+height/2);
    CurveToC(x,
             y+height/2-height/2*11/20,
             x+width/2-width/2*11/20,
             y,
             x+width/2,
             y);
    CurveToC(x+width/2+width/2*11/20,
             y,
             x+width,
             y+height/2-height/2*11/20,
             x+width,
             y+height/2);
    CurveToC(x+width,
             y+height/2+height/2*11/20,
             x+width/2+width/2*11/20,
             y+height,
             x+width/2,
             y+height);
    CurveToC(x+width/2-width/2*11/20,
             y+height,
             x,
             y+height/2+height/2*11/20,
             x,
             y+height/2);
end;

// GetNextWord
function TPdfCanvas.GetNextWord(const S: string;
  var Index: integer): string;
var
  ln: integer;
  i: integer; 
begin
  // getting a word from text.
  result := ''; 
  ln := Length(S);
  if Index > ln then
    Exit;
  i := Index;
  while true do
    if ((S[i] = #10) and (S[i-1] = #13)) or (S[i] = ' ') then
    begin
      result := Copy(S, Index, i - (Index -1));
      break;
    end
    else
    if i >= ln then
    begin
      result := Copy(S, Index, i - (Index - 1));
      break;
    end
    {$IFDEF USE_JPFONTS}
    else
    if ByteType(S, i) = mbTrailByte then
      if ((Copy(S, i+1, 2) <> #129#66) and
        (Copy(S, i+1, 2) <> #129#65)) then
      begin
        result := Copy(S, Index, i - (Index - 1));
        break;
      end
      else
        inc(i)
    else
    if ((i < ln) and (ByteType(S, i + 1) = mbLeadByte)) then
    begin
      result := Copy(S, Index, i - (Index - 1));
      break;
    end
    {$ENDIF}
    else
      inc(i);

    Index := i + 1;
end;

// GetDoc
function TPdfCanvas.GetDoc: TPdfDoc;
begin
  result := nil;
  if FPdfDoc <> nil then
    result := FPdfDoc
  else
    EPdfInvalidOperation.Create('ERROR: GetDoc documant is nil.');
end;

{ TPdfDictionaryWrapper }

// SetData
procedure TPdfDictionaryWrapper.SetData(AData: TPdfDictionary);
begin
  FData := AData;
end;

// GetHasData
function TPdfDictionaryWrapper.GetHasData: boolean;
begin
  result := (FData = nil);
end;

{ TPdfInfo }

// SetAuthor
procedure TPdfInfo.SetAuthor(Value: string);
begin
  FData.AddItem('Author', TPdfText.CreateText(Value));
end;

// SetCreationDate
procedure TPdfInfo.SetCreationDate(Value: TDateTime);
begin
  FData.AddItem('CreationDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
end;

// SetModDate
procedure TPdfInfo.SetModDate(Value: TDateTime);
begin
  FData.AddItem('ModDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
end;

// SetCreator
procedure TPdfInfo.SetCreator(Value: string);
begin
  FData.AddItem('Creator', TPdfText.CreateText(Value));
end;

// SetTitle
procedure TPdfInfo.SetTitle(Value: string);
begin
  FData.AddItem('Title', TPdfText.CreateText(Value));
end;

// SetSubject
procedure TPdfInfo.SetSubject(Value: string);
begin
  FData.AddItem('Subject', TPdfText.CreateText(Value));
end;

// SetKeywords
procedure TPdfInfo.SetKeywords(Value: string);
begin
  FData.AddItem('Keywords', TPdfText.CreateText(Value));
end;

// GetAuthor
function TPdfInfo.GetAuthor: string;
begin
  if FData.ValueByName('Author') <> nil then
    result := FData.PdfTextByName('Author').Value
  else
    result := '';
end;

// GetCreationDate
function TPdfInfo.GetCreationDate: TDateTime;
begin
  if FData.ValueByName('CreationDate') <> nil then
  try
    result := _PdfDateToDateTime(FData.PdfTextByName('CreationDate').Value);
  except
    result := 0;
  end
  else
    result := 0;
end;

// GetModDate
function TPdfInfo.GetModDate: TDateTime;
begin
  if FData.ValueByName('ModDate') <> nil then
  try
    result := _PdfDateToDateTime(FData.PdfTextByName('ModDate').Value);
  except
    result := 0;
  end
  else
    result := 0;
end;

// GetCreator
function TPdfInfo.GetCreator: string;
begin
  if FData.ValueByName('Creator') <> nil then
    result := FData.PdfTextByName('Creator').Value
  else
    result := '';
end;

// GetTitle
function TPdfInfo.GetTitle: string;
begin
  if FData.ValueByName('Title') <> nil then
    result := FData.PdfTextByName('Title').Value
  else
    result := '';
end;

// GetSubject
function TPdfInfo.GetSubject: string;
begin
  if FData.ValueByName('Subject') <> nil then
    result := FData.PdfTextByName('Subject').Value
  else
    result := '';
end;

// GetKeywords
function TPdfInfo.GetKeywords: string;
begin
  if FData.ValueByName('Keywords') <> nil then
    result := FData.PdfTextByName('Keywords').Value
  else
    result := '';
end;

{ TPdfCatalog }

// SaveOpenAction
procedure TPdfCatalog.SaveOpenAction;
begin
  if (FOpenAction = nil) then
    FData.RemoveItem('OpenAction')
  else
    FData.AddItem('OpenAction', FOpenAction.GetValue);
end;

// SetPageLayout
procedure TPdfCatalog.SetPageLayout(Value: TPdfPageLayout);
var
  FPageLayout: TPdfName;
begin
  FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
  if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
    FData.AddItem('PageLayout', TPdfName.CreateName(PDF_PAGE_LAYOUT_NAMES[Ord(Value)]))
  else
    FPageLayout.Value := PDF_PAGE_LAYOUT_NAMES[Ord(Value)];
end;

// GetPageLayout
function TPdfCatalog.GetPageLayout: TPdfPageLayout;
var
  FPageLayout: TPdfName;
  S: string;
  i: integer;
begin
  result := plSinglePage;
  FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
  if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
    Exit
  else
  begin
    S := FPageLayout.Value;
    for i := 0 to High(PDF_PAGE_LAYOUT_NAMES) do
      if PDF_PAGE_LAYOUT_NAMES[i] = S then
      begin
        result := TPdfPageLayout(i);
        Break;
      end;
  end;
end;

function TPdfCatalog.GetNonFullScreenPageMode: TPdfPageMode;
var
  FDictionary: TPdfDictionary;
  FPageMode: TPdfName;
  S: string;
  i: integer;
begin
  result := pmUseNone;
  FDictionary := TPdfDict