pdftypes.pas

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

function TPdfArray.GetItems(Index: integer): TPdfObject;
begin
  result := TPdfObject(FArray[Index]);
  if result.ObjectType = otVirtualObject then
    result := FObjectMgr.GetObject(result.ObjectNumber);
end;

function TPdfArray.GetItemCount: integer;
begin
  Result := FArray.Count;
end;

procedure TPdfArray.InternalWriteStream(const AStream: TStream);
var
  i: integer;
begin
  _WriteString('[', AStream);
  for i := 0 to FArray.Count - 1 do
  begin
    TPdfObject(FArray[i]).WriteToStream(AStream);
    _WriteString(' ', AStream);
  end;
  _WriteString(']', AStream);
end;

constructor TPdfArray.CreateArray(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;
end;

constructor TPdfArray.CreateNumArray(AObjectMgr: TPdfObjectMgr; AArray: array of Integer);
var
  i: integer;
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;

  for i := 0 to High(AArray) do
    AddItem(TPdfNumber.CreateNumber(AArray[i]));
end;

destructor TPdfArray.Destroy;
var
  i: integer;
begin
  for i := 0 to FArray.Count - 1 do
    TPdfObject(FArray[i]).Free;
  FArray.Free;
  inherited;
end;

procedure TPdfArray.AddItem(AItem: TPdfObject);
var
  TmpObject: TPdfVirtualObject;
begin
  {*
   * if AItem already exists, do nothing 
   *}
  if FArray.IndexOf(AItem) >= 0 then Exit;

  if AItem.ObjectType = otDirectObject then
    FArray.Add(AItem)
  else
  begin
    TmpObject := TPdfVirtualObject.CreateVirtual(AItem.ObjectNumber);
    FArray.Add(TmpObject)
  end;
end;

function TPdfArray.FindName(AName: string): TPdfName;
var
  i: integer;
  FPdfName: TPdfName;
begin
  result := nil;
  for i := 0 to ItemCount - 1 do
  begin
    FPdfName := TPdfName(Items[i]);
    if (FPdfName <> nil) and
      (FPdfName is TPdfName) and
      (FPdfName.Value = AName) then
      begin
        result := FPdfName;
        break;
      end;
  end;
end;

function TPdfArray.RemoveName(AName: string): boolean;
var
  AObject: TPdfObject;
begin
  result := false;
  AObject := FindName(AName);
  if AObject <> nil then
  begin
    FArray.Remove(AObject);
    if AObject.ObjectType = otDirectObject then
      AObject.Free;
    result := true;
  end;
end;

{ TPdfDictionaryElement }

function TPdfDictionaryElement.GetKey: string;
begin
  result := FKey.Value;
end;

constructor TPdfDictionaryElement.Create(AKey: string; AValue: TPdfObject);
begin
  FKey := TPdfName.Create;
  FKey.Value := AKey;
  if not (AValue is TPdfObject) then
    raise EPdfInvalidValue.Create('');
  FValue := AValue;
  FIsInternal := false;
end;

constructor TPdfDictionaryElement.CreateAsInternal(AKey: string; AValue: TPdfObject; AVoid: Pointer);
begin
  Create(AKey, AValue);
  FIsInternal := true;
end;

destructor TPdfDictionaryElement.Destroy;
begin
  FKey.Free;
  FValue.Free;
  inherited;
end;

{ TPdfDictionary }

function TPdfDictionary.GetItems(Index: integer): TPdfDictionaryElement;
begin
  result := TPdfDictionaryElement(FArray[Index]);
end;

function TPdfDictionary.GetItemCount: integer;
begin
  Result := FArray.Count;
end;

procedure TPdfDictionary.InternalWriteStream(const AStream: TStream);
var
  i: integer;
  FElement: TPdfDictionaryElement;
begin
  _WriteString('<<'#13#10, AStream);
  for i := 0 to FArray.Count - 1 do
  begin
    FElement := GetItems(i);
    if not FElement.IsInternal then
    begin
      FElement.FKey.WriteToStream(AStream);
      _WriteString(' ', AStream);
      FElement.FValue.WriteToStream(AStream);
      _WriteString(#13#10, AStream);
    end;
  end;
  _WriteString('>>', AStream);
end;

constructor TPdfDictionary.CreateDictionary(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;
end;

destructor TPdfDictionary.Destroy;
var
  i: integer;
  FElement: TPdfDictionaryElement;
begin
  {*
   * destroy all child objects.
   *}
  for i := 0 to FArray.Count - 1 do
  begin
    FElement := Items[i];
    FElement.Free;
  end;
  FArray.Free;
  inherited;
end;

function TPdfDictionary.ValueByName(AKey: string): TPdfObject;
var
  i: integer;
  FElement: TPdfDictionaryElement;
begin
  result := nil;
  for i := 0 to FArray.Count - 1 do
  begin
    FElement := Items[i];
    if FElement.Key = AKey then
    begin
      result := FElement.Value;
      if result.ObjectType = otVirtualObject then
        result := FObjectMgr.GetObject(result.ObjectNumber);
      Break;
    end;
  end;
end;

function TPdfDictionary.PdfNumberByName(AKey: string): TPdfNumber;
begin
  result := TPdfNumber(ValueByName(AKey));
end;

function TPdfDictionary.PdfTextByName(AKey: string): TPdfText;
begin
  result := TPdfText(ValueByName(AKey));
end;

function TPdfDictionary.PdfRealByName(AKey: string): TPdfReal;
begin
  result := TPdfReal(ValueByName(AKey));
end;

function TPdfDictionary.PdfStringByName(AKey: string): TPdfString;
begin
  result := TPdfString(ValueByName(AKey));
end;

function TPdfDictionary.PdfNameByName(AKey: string): TPdfName;
begin
  result := TPdfName(ValueByName(AKey));
end;

function TPdfDictionary.PdfDictionaryByName(AKey: string): TPdfDictionary;
begin
  result := TPdfDictionary(ValueByName(AKey));
end;

function TPdfDictionary.PdfArrayByName(AKey: string): TPdfArray;
begin
  result := TPdfArray(ValueByName(AKey));
end;

procedure TPdfDictionary.AddItem(AKey: string; AValue: TPdfObject);
var
  FItem: TPdfDictionaryElement;
  FTmpObject: TPdfVirtualObject;
begin
  // make PdfDictionaryElement with given key and value. and add it to list.
  // if the element exists, replace value of element by given value.
  RemoveItem(AKey);
  if AValue.ObjectType = otDirectObject then
    FItem := TPdfDictionaryElement.Create(AKey, AValue)
  else
  begin
    FTmpObject := TPdfVirtualObject.CreateVirtual(AValue.ObjectNumber);
    FItem := TPdfDictionaryElement.Create(AKey, FTmpObject);
  end;
  FArray.Add(FItem);
end;

procedure TPdfDictionary.AddNumberItem(AKey: string; AValue: Integer);
begin
  AddItem(AKey, TPdfNumber.CreateNumber(AValue));
end;

procedure TPdfDictionary.AddNameItem(AKey: string; AValue: string);
begin
  AddItem(AKey, TPdfName.CreateName(AValue));
end;

procedure TPdfDictionary.AddInternalItem(AKey: string; AValue: TPdfObject);
var
  FItem: TPdfDictionaryElement;
  FTmpObject: TPdfVirtualObject;
begin
  // make PdfDictionaryElement as internal object with given key and value.
  // internal object use only in pdfdoc process and not write to stream.
  RemoveItem(AKey);
  if AValue.ObjectType = otDirectObject then
    FItem := TPdfDictionaryElement.CreateAsInternal(AKey, AValue, nil)
  else
  begin
    FTmpObject := TPdfVirtualObject.CreateVirtual(AValue.ObjectNumber);
    FItem := TPdfDictionaryElement.CreateAsInternal(AKey, FTmpObject, nil);
  end;
  FArray.Add(FItem);
end;

procedure TPdfDictionary.RemoveItem(AKey: string);
var
  i: integer;
  FElement: TPdfDictionaryElement;
begin
  // remove PdfDictionaryElement with given key.
  // if the element not exists, do nothing.
  for i := 0 to FArray.Count - 1 do
  begin
    FElement := Items[i];
    if FElement.Key = AKey then
    begin
      FArray.Remove(FElement);
      FElement.Free;
      Break;
    end;
  end;
end;

{TPdfStream}

procedure TPdfStream.InternalWriteStream(const AStream: TStream);
var
  FLength: TPdfNumber;
  FFilter: TPdfArray;
  TmpStream: TStream;

begin
  FLength := FAttributes.PdfNumberByName('Length');
  FFilter := TPdfArray(FAttributes.ValueByName('Filter'));
  TmpStream := TMemoryStream.Create;

{$IFDEF NOZLIB}
  FFilter.RemoveName('FlateDecode');
{$ELSE}
  if FFilter.FindName('FlateDecode') <> nil then
    with TCompressionStream.Create(clMax, TmpStream) do
    begin
      CopyFrom(FStream, 0);
      Free;
    end
  else
{$ENDIF}
    TmpStream.CopyFrom(FStream, 0);
  FLength.Value := TmpStream.Size;

  FAttributes.WriteToStream(AStream);
  _WriteString(#13#10'stream'#13#10, AStream);

  AStream.CopyFrom(TmpStream, 0);
  TmpStream.Free;

  _WriteString(#10'endstream', AStream);
end;

constructor TPdfStream.CreateStream(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FAttributes := TPdfDictionary.CreateDictionary(AObjectMgr);
  FAttributes.AddItem('Length', TPdfNumber.Create);
  FAttributes.AddItem('Filter', TPdfArray.CreateArray(AObjectMgr));
  FStream := TMemoryStream.Create;
end;

destructor TPdfStream.Destroy;
begin
  FStream.Free;
  FAttributes.Free;
  inherited;
end;

{ utility functions }

function _DateTimeToPdfDate(ADate: TDateTime): TPdfDate;
begin
  result := FormatDateTime('"D:"yyyymmddhhnnss', now);
end;

function _PdfDateToDateTime(AText: TPdfDate): TDateTime;
var
  yy, mm, dd, hh, nn, ss: Word;
begin
  if Length(AText) <> 16 then
    EConvertError.Create('');
  yy := StrToInt(Copy(AText, 3, 4));
  mm := StrToInt(Copy(AText, 7, 2));
  dd := StrToInt(Copy(AText, 9, 2));
  hh := StrToInt(Copy(AText, 11, 2));
  nn := StrToInt(Copy(AText, 13, 2));
  ss := StrToInt(Copy(AText, 15, 2));
  result := EncodeDate(yy, mm, dd) + EncodeTime(hh, nn, ss, 0);
end;

function _StrToUnicodeHex(const Value: string): string;
var
  PW: Pointer;
  PByte: ^Byte;
  HiByte, LoByte: Byte;
  Len: integer;
  i: integer;
begin
  result := '';
  Len := MultiByteToWideChar(0, CP_ACP,
    PChar(Value), Length(Value), nil, 0);
  GetMem(PW, Len * 2);
  Len := MultiByteToWideChar(0, CP_ACP,
    PChar(Value), Length(Value), PW, Len * 2);
  PByte := Pw;
  i := 0;
  while i < Len do
  begin
    LoByte := PByte^;
    inc(PByte);
    HiByte := PByte^;
    inc(PByte);
    result := result + IntToHex(HiByte, 2) + IntToHex(LoByte, 2);
    inc(i);
  end;
  FreeMem(PW, Len * 2);
end;

function _StrToHex(const Value: string): string;
var
  i: integer;
begin
  // Return octal code for value.
  result := '';
  for i := 1 to Length(Value) do
    result := result + IntToHex(ord(Value[i]), 2);
end;

function _HasMultiByteString(const Value: string): boolean;
var
  i: integer;
begin
  result := false;
  for i := 1 to Length(Value) do
    if ByteType(Value, i) <> mbSingleByte then
    begin
      result := true;
      Break;
    end;
end;

function _EscapeText(const Value: string): string;
const
  EscapeChars: string = '()\'#13#10#09#08#12;
  ReplaceChars: string = '()\rntbf';
var
  i, j: integer;
  flg: boolean;
begin
  //  If text contains chars to need escape, replace text using "\".
  result := '';
  for i := 1 to Length(Value) do
  begin
    flg := false;
    for j := 1 to Length(EscapeChars) do
      if Value[i] = EscapeChars[j] then
      begin
        result := result + '\' + ReplaceChars[j];
        flg := true;
        break;
      end;

    if not flg then
       result := result + Value[i];
  end;
end;

function _GetTypeOf(ADictionary: TPdfDictionary): string;
var
  PdfName: TPdfName;
begin
  // return the type of the pdfdictionary object
  PdfName := ADictionary.PdfNameByName('Type');
  if PdfName <> nil then
    result := PdfName.Value
  else
    result := '';
end;

procedure _WriteString(const Value: string; AStream: TStream);
begin
  AStream.Write(PChar(Value)^, Length(Value));
end;

end.