pdfdoc.pas

作者:Takeshi Kanno. PowerPdf是一款制作PDF文档的VCL控件。使用上和QuickReport类似。

procedure TPdfCanvas.NewPath;
begin
  _WriteString('n'#10, FContents.Stream);
end;

procedure TPdfCanvas.Stroke;
begin
  _WriteString('S'#10, FContents.Stream);
end;

procedure TPdfCanvas.ClosePathStroke;
begin
  _WriteString('s'#10, FContents.Stream);
end;

procedure TPdfCanvas.Fill;
begin
  _WriteString('f'#10, FContents.Stream);
end;

procedure TPdfCanvas.Eofill;
begin
  _WriteString('f*'#10, FContents.Stream);
end;

procedure TPdfCanvas.FillStroke;
begin
  _WriteString('B'#10, FContents.Stream);
end;

procedure TPdfCanvas.ClosepathFillStroke;
begin
  _WriteString('b'#10, FContents.Stream);
end;

procedure TPdfCanvas.EofillStroke;
begin
  _WriteString('B*'#10, FContents.Stream);
end;

procedure TPdfCanvas.ClosepathEofillStroke;
begin
  _WriteString('b*'#10, FContents.Stream);
end;

procedure TPdfCanvas.Clip;
begin
  _WriteString('W'#10, FContents.Stream);
end;

procedure TPdfCanvas.Eoclip;
begin
  _WriteString('W*'#10, FContents.Stream);
end;

  {* Test state *}
procedure TPdfCanvas.SetCharSpace(charSpace: Single);
begin
  if FAttr.CharSpace = charSpace then Exit;
  FAttr.SetCharSpace(charSpace);
  if Contents <> nil then
    _WriteString(FloatToStr(charSpace) + ' Tc'#10, FContents.Stream);
end;

procedure TPdfCanvas.SetWordSpace(wordSpace: Single);
begin
  if FAttr.WordSpace = wordSpace then Exit;
  FAttr.SetWordSpace(wordSpace);
  if Contents <> nil then
    _WriteString(FloatToStr(wordSpace) + ' Tw'#10, FContents.Stream);
end;

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

procedure TPdfCanvas.SetLeading(leading: Single);
begin
  _WriteString(FloatToStr(leading) + ' TL'#10, FContents.Stream);
end;

procedure TPdfCanvas.SetFontAndSize(fontname: string; size: Single);
var
  S: string;
begin
  S := fontname + ' ' +
       FloatToStr(size) + ' Tf'#10;
  _WriteString(S, FContents.Stream);
end;

procedure TPdfCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
begin
  _WriteString(IntToStr(ord(mode)) + ' Tr'#10, FContents.Stream);
end;

procedure TPdfCanvas.SetTextRise(rise: Word);
begin
  _WriteString(IntToStr(rise) + ' Ts'#10, FContents.Stream);
end;

procedure TPdfCanvas.BeginText;
begin
  _WriteString('BT'#10, FContents.Stream);
end;

procedure TPdfCanvas.EndText;
begin
  _WriteString('ET'#10, FContents.Stream);
end;

procedure TPdfCanvas.MoveTextPoint(tx, ty: Word);
var
  S: string;
begin
  S := IntToStr(tx) + ' ' +
       IntToStr(ty) + ' Td'#10;
  _WriteString(S, FContents.Stream);
end;

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, FContents.Stream);
end;

procedure TPdfCanvas.MoveToNextLine;
begin
  _WriteString('T*'#10, FContents.Stream);
end;

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

{ TPdfCanvas common routine }
function TPdfCanvas.TextWidth(Text: string): Single;
begin
  result := FAttr.TextWidth(Text);
end;

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

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

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

procedure TPdfCanvas.SetRGBFillColor(Value: TColor);
var
  S: string;
begin
  S := GetColorStr(Value) + ' rg'#10;
  _WriteString(S, FContents.Stream);
end;

procedure TPdfCanvas.SetRGBStrokeColor(Value: TColor);
var
  S: string;
begin
  S := GetColorStr(Value) + ' RG'#10;
  _WriteString(S, FContents.Stream);
end;

function TPdfCanvas.GetDoc: TPdfDoc;
begin
  result := FPdfDoc;
end;

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

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

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

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

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

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

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

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

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

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

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;

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;

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

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

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

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

{ TPdfCatalog }

procedure TPdfCatalog.SetPageMode(Value: TPdfPageMode);
var
  FPageMode: TPdfName;
begin
  FPageMode := TPdfName(FData.ValueByName('PageMode'));
  if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
    FData.AddItem('PageMode', TPdfName.CreateName(PDF_PAGE_MODE_NAMES[Ord(Value)]))
  else
    FPageMode.Value := PDF_PAGE_MODE_NAMES[Ord(Value)];
end;

function TPdfCatalog.GetPageMode: TPdfPageMode;
var
  FPageMode: TPdfName;
  S: string;
  i: integer;
begin
  result := pmUseNone;
  FPageMode := TPdfName(FData.ValueByName('PageMode'));
  if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
    Exit
  else
  begin
    S := FPageMode.Value;
    for i := 0 to High(PDF_PAGE_MODE_NAMES) do
      if PDF_PAGE_MODE_NAMES[i] = S then
      begin
        result := TPdfPageMode(i);
        Break;
      end;
  end;
end;

procedure TPdfCatalog.SetUseOutlines(Value: boolean);
begin
  if Value = UseOutlines then
    Exit;
  if Value then
    CreateOutlines
  else
  begin
    FData.RemoveItem('Outlines');
    FOutlines := nil;
  end;
end;

function TPdfCatalog.GetUseOutlines: boolean;
begin
  if FData.ValueByName('Outlines') <> nil then
    result := true
  else
    result := false;
end;

function TPdfCatalog.GetPages: TPdfDictionary;
begin
  result := TPdfDictionary(FData.ValueByName('Pages'));
  if result = nil then
    raise EPdfInvalidOperation.Create('ERROR: page object is null..');
end;

procedure TPdfCatalog.SetPages(APage: TPdfDictionary);
begin
  if _GetTypeOf(APage) = 'Pages' then
  begin
    FData.AddItem('Pages', APage);
    FPages := APage;
  end;
end;

function TPdfCatalog.GetOutlines: TPdfDictionary;
begin
  if FOutlines = nil then
    FOutlines := TPdfDictionary(FData.ValueByName('Outlines'));
  if FOutlines = nil then
    raise EPdfInvalidOperation.Create('This Document has no outlines..');
  result := FOutlines;
end;

procedure TPdfCatalog.CreateOutlines;
var
  FOutlines: TPdfOutlines;
begin
  FOutlines := TPdfOutlines.CreateDictionary(FData.ObjectMgr);
  FData.ObjectMgr.AddObject(FOutlines);
  with FOutLines do
  begin
    AddItem('Type', TPdfName.CreateName('Outlines'));
    AddItem('Count', TPdfNumber.CreateNumber(0));
    AddInternalItem('Opened', TPdfNumber.CreateNumber(PDF_ENTRY_OPENED));
  end;
  FData.AddItem('Outlines', FOutlines);
end;

{ TPdfFont }
procedure TPdfFont.AddStrElements(ADic: TPdfDictionary;
  ATable: array of TPDF_STR_TBL);
var
  i: integer;
begin
  { utility routine for making font dictinary. }
  for i := 0 to High(ATable) do
    ADic.AddItem(ATable[i].KEY, TPdfName.CreateName(ATable[i].VAL));
end;

procedure TPdfFont.AddIntElements(ADic: TPdfDictionary;
  ATable: array of TPDF_INT_TBL);
var
  i: integer;
begin
  { utility routine for making font dictinary. }
  for i := 0 to High(ATable) do
    ADic.AddItem(ATable[i].KEY, TPdfNumber.CreateNumber(ATable[i].VAL));
end;

function TPdfFont.GetCharWidth(AText: string; APos: integer): integer;
begin
  result := 0;
end;

constructor TPdfFont.Create(AXref: TPdfXref; AName: string);
begin
  inherited Create;
  FName := AName;
end;

{$IFNDEF NOIMAGE}

{ TPdfImageCreator }
function TPdfImageCreator.CreateImage(AXref: TPdfXref; AImage: TGraphic): TPdfXObject;
begin
  result := nil;
end;

constructor TPdfImageCreator.Create;
begin
  inherited;
end;
{$ENDIF}

end.