⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vpdfdoc.pas

📁 生成PDF文档的控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asSquare:
      begin
        AnotDict.AddNameValue('Subtype', 'Square');
        AnotDict.AddStringValue('Contents', FContents);
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asCircle:
      begin
        AnotDict.AddNameValue('Subtype', 'Circle');
        AnotDict.AddStringValue('Contents', FContents);
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asStamp:
      begin
        AnotDict.AddNameValue('Subtype', 'Stamp');
        AnotDict.AddStringValue('Contents', FContents);
        AnotDict.AddNameValue('Name', FTypeState);
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asFileAttachment:
      begin
        MFS := TFileStream.Create(String(FName), fmOpenRead);
        try
          MFS.Position := 0;
          Inc(Fpage.FParent.FMaxObjNum);
          AttS := TVPDFStreamObject.Create(nil);
          AttS.IsIndirect := true;
          AttS.ID.ObjectNumber := Fpage.FParent.FMaxObjNum;
          Fpage.FParent.IndirectObjects.Add(AttS);
          AttS.Stream.CopyFrom(MFS, 0);
          FilSpec := FPage.FParent.CreateIndirectDictionary;
          FilSpec.AddNameValue('Type', 'Filespec');
          FilSpec.AddStringValue('F', AnsiString(ExtractFileName(String(FName))));
          FilSpec.AddValue('EF', AttS);
          AnotDict.AddNameValue('Subtype', 'FileAttachment');
          AnotDict.AddStringValue('Contents', FContents);
          RectArray := TVPDFArrayObject.Create(nil);
          RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
          RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
          RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
          RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
          AnotDict.AddValue('Rect', RectArray);
          AnotDict.AddValue('P', Fpage.PageObj);
          AnotDict.AddValue('FS', FilSpec);
        finally
          MFS.Free;
        end;
      end;
    asSound:
      begin
        MFS := TFileStream.Create(String(FName), fmOpenRead);
        try
          MFS.Position := 0;
          Inc(Fpage.FParent.FMaxObjNum);
          AttS := TVPDFStreamObject.Create(nil);
          AttS.IsIndirect := true;
          AttS.ID.ObjectNumber := Fpage.FParent.FMaxObjNum;
          Fpage.FParent.IndirectObjects.Add(AttS);
          AttS.Stream.CopyFrom(MFS, 0);
          AttS.Dictionary.AddNameValue('Type', 'Sound');
          AttS.Dictionary.AddNumericValue('R', 22050);
          AttS.Dictionary.AddNumericValue('B', 16);
          AttS.Dictionary.AddNumericValue('C', 2);
          AttS.Dictionary.AddNameValue('E', 'Signed');
          AnotDict.AddNameValue('Subtype', 'Sound');
          AnotDict.AddStringValue('Contents', FContents);
          RectArray := TVPDFArrayObject.Create(nil);
          RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
          RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
          RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
          RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
          AnotDict.AddValue('Rect', RectArray);
          AnotDict.AddValue('P', Fpage.PageObj);
          AnotDict.AddValue('Sound', AttS);
        finally
          MFS.Free;
        end;
      end;
    asMovie:
      begin
        FilSpec := FPage.FParent.CreateIndirectDictionary;
        FilSpec.AddNameValue('Type', 'Filespec');
        FilSpec.AddStringValue('F', AnsiString(ConvertFileName(String(FName))));
        AnotDict.AddNameValue('Subtype', 'Movie');
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddBooleanValue('A', true);
        AnotDict.AddValue('FS', FilSpec);
        MediaF := FPage.FParent.CreateIndirectDictionary;
        MediaF.AddValue('F', FilSpec);
        AspectArray := TVPDFArrayObject.Create(nil);
        AspectArray.AddNumericValue(352);
        AspectArray.AddNumericValue(18);
        MediaF.AddBooleanValue('Poster', true);
        MediaF.AddValue('Aspect', AspectArray);
        AnotDict.AddValue('Movie', MediaF);
      end;
  end;
  AnotDict.AddValue('C', ColorArray);
  FPage.FAnnotsObj.AddObject(AnotDict);
end;

{ TVPDF }

constructor TVPDF.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DocScale := 1;
  FVPChanged := false;
  FMemStream := false;
  FIsLoaded := false;
  FDocStarted := false;
  FProgress := false;
  FAutoLaunch := true;
  FPageMode := pmUseNone;
  FCompressionMethod := cmFlateDecode;
  FStandardFontEmulation := true;
  FFontEmbedding := true;
  FResolution := 72;
  FJpegQuality := 100;
  FShowInfo := true;
  FastOpen := '';
  FastClose := '';
  FastWillSave := '';
  FastDidSave := '';
  FastWillPrint := '';
  FastDidPrint := '';
  FNEmbeddedFonts := TStringList.Create;
  FAuthor := 'VisPDF Lib User';
  FTitle := 'Delphi PDF library VisPDF Lib';
  FKeywords := 'pdf delphi component';
  FCreationDate := Now;
  IndirectObjects := TList.Create;
  FCurrentPage := nil;
  FCurrentPageNum := -1;
  FCHandle := GetDC( 0 );
  SamCorrel := false;
  FParas := nil;
  FParaLen := 0;
  FActivePara := 0;
  FAutoAddPage := true;
  FRevision := 2;
  FVersion := pdf14;
end;

destructor TVPDF.Destroy;
begin
  FXref := nil;
  PageArr := nil;
  FNEmbeddedFonts.Free;
  CloseIndirectObjects;
  ReleaseDC ( 0, FCHandle );
  inherited;
end;

function TVPDF.FontIsEmbedded(FontNm: AnsiString): boolean;
var
  I: Integer;
begin
  Result := true;
  for I := 0 to NotEmbeddedFonts.Count - 1 do
  begin
    if (NotEmbeddedFonts.Strings[I] = String(FontNm)) then
    begin
      Result := false;
      Exit;
    end;
  end;
end;

procedure TVPDF.AddDocumentAttachment(FileName: TFileName; Description: AnsiString);
var
  EFNamesInd, NmInd, EFSpecInd: Integer;
  EFSpec: TVPDFDictionaryObject;
  EFArr: TVPDFArrayObject;
  FS: TFileStream;
  EF: TVPDFDictionaryObject;
  FSpec: TVPDFDictionaryObject;
  EFNamesObj, EFSpecObj, NamesObj: TVPDFObject;
  ParamsObj: TVPDFDictionaryObject;
  AttachStream: TVPDFStreamObject;
  RootDictObj: TVPDFDictionaryObject;
  NamesDict: TVPDFDictionaryObject;
begin
  RootDictObj := TVPDFDictionaryObject(IndirectObjects.Items[FRootIndex]);
  NmInd := RootDictObj.FindValue('Names');
  if (NmInd >= 0) then
  begin
    NamesObj := RootDictObj.GetIndexedItem(NmInd);
    if (NamesObj.ObjectType = otLink) then
    begin
      NamesDict := TVPDFDictionaryObject(GetObjectByLink(TVPDFLink(NamesObj)));
    end
    else
    begin
      NamesDict := TVPDFDictionaryObject(NamesObj);
    end;
  end
  else
  begin
    NamesDict := CreateIndirectDictionary;
    RootDictObj.AddValue('Names', NamesDict);
  end;
  FSpec := CreateIndirectDictionary;
  EFSpecInd := NamesDict.FindValue('EmbeddedFiles');
  if (EFSpecInd >= 0) then
  begin
    EFSpecObj := NamesDict.GetIndexedItem(EFSpecInd);
    if (EFSpecObj.ObjectType = otLink) then
    begin
      EFSpec := TVPDFDictionaryObject(GetObjectByLink(TVPDFLink(EFSpecObj)));
    end
    else
    begin
      EFSpec := TVPDFDictionaryObject(EFSpecObj);
    end;
  end
  else
  begin
    EFSpec := CreateIndirectDictionary;
  end;
  EFNamesInd := EFSpec.FindValue('Names');
  if (EFNamesInd >= 0) then
  begin
    EFNamesObj := EFSpec.GetIndexedItem(EFNamesInd);
    if (EFNamesObj.ObjectType = otLink) then
    begin
      EFArr := TVPDFArrayObject(GetObjectByLink(TVPDFLink(EFNamesObj)));
    end
    else
    begin
      EFArr := TVPDFArrayObject(EFNamesObj);
    end;
  end
  else
  begin
    EFArr := TVPDFArrayObject.Create(nil);
    EFSpec.AddValue('Names', EFArr);
  end;
  EFArr.AddStringValue(AnsiString(ExtractFileName(String(FileName))));
  EFArr.AddObject(FSpec);
  NamesDict.AddValue('EmbeddedFiles', EFSpec);
  FS := TFileStream.Create(FileName, fmOpenRead);
  try
    Inc(FMaxObjNum);
    AttachStream := TVPDFStreamObject.Create(nil);
    AttachStream.IsIndirect := true;
    AttachStream.ID.ObjectNumber := FMaxObjNum;
    IndirectObjects.Add(AttachStream);
    AttachStream.Dictionary.AddNumericValue('DL', FS.Size);
    ParamsObj := TVPDFDictionaryObject.Create(nil);
    ParamsObj.AddStringValue('CreationDate', _DateTimeToPdfDate(Now));
    ParamsObj.AddStringValue('ModDate', _DateTimeToPdfDate(Now));
    ParamsObj.AddNumericValue('Size', FS.Size);
    AttachStream.Dictionary.AddValue('Params', ParamsObj);
    AttachStream.Stream.CopyFrom(FS, 0);
  finally
    FS.Free;
  end;
  FSpec.AddStringValue('F', AnsiString(ExtractFileName(String(FileName))));
  FSpec.AddStringValue('Desc', Description);
  FSpec.AddNameValue('Type', 'Filespec');
  EF := TVPDFDictionaryObject.Create(nil);
  EF.AddValue('F', AttachStream);
  FSpec.AddValue('EF', EF);
end;

function TVPDF.AddPage: Integer;
var
  BlockInd: Integer;
  PagesObj: TVPDFDictionaryObject;
  PageObj: TVPDFDictionaryObject;
  ResourObj: TVPDFDictionaryObject;
  PXObObj: TVPDFDictionaryObject;
  PageContObj: TVPDFStreamObject;
  MediaBoxObj: TVPDFArrayObject;
  ProcSetObj: TVPDFArrayObject;
  DecodeParm: TVPDFArrayObject;
  FilterVal: TVPDFArrayObject;

begin
  Inc(FPagesCount);
  PagesObj := TVPDFDictionaryObject(IndirectObjects.Items[FPagesIndex]);
  BlockInd := PagesObj.FindValue('Count');
  if (BlockInd >= 0) then
    TVPDFNumericObject(PagesObj.GetIndexedItem(BlockInd)).Value := FPagesCount;
  PageObj := CreateIndirectDictionary;
  PageObj.AddNameValue('Type', 'Page');
  PageObj.AddValue('Parent', PagesObj);
  FParentMB[0] := 0;
  FParentMB[1] := 0;
  FParentMB[2] := 595;
  FParentMB[3] := 842;
  FIsParented := false;
  MediaBoxObj := TVPDFArrayObject.Create(nil);
  MediaBoxObj.AddNumericValue(0);
  MediaBoxObj.AddNumericValue(0);
  MediaBoxObj.AddNumericValue(595);
  MediaBoxObj.AddNumericValue(842);
  PageObj.AddValue('MediaBox', MediaBoxObj);
  PXObObj := TVPDFDictionaryObject.Create(nil);
  ProcSetObj := TVPDFArrayObject.Create(nil);
  ProcSetObj.AddNameValue('PDF');
  ProcSetObj.AddNameValue('Text');
  ProcSetObj.AddNameValue('ImageC');
  ResourObj := TVPDFDictionaryObject.Create(nil);
  PageObj.AddValue('Resources', ResourObj);
  ResourObj.AddValue('ProcSet', ProcSetObj);
  ResourObj.AddValue('XObject', PXObObj);
  PageContObj := TVPDFStreamObject.Create(nil);
  Inc(FMaxObjNum);
  PageContObj.IsIndirect := true;
  PageContObj.ID.ObjectNumber := FMaxObjNum;
  IndirectObjects.Add(PageContObj);
  PageObj.AddValue('Contents', PageContObj);
  PageContObj.Dictionary.AddNumericValue('Length', 0);
  FilterVal := TVPDFArrayObject.Create(nil);
  PageContObj.Dictionary.AddValue('Filter', FilterVal);
  DecodeParm := TVPDFArrayObject.Create(nil);
  PageContObj.Dictionary.AddValue('DecodeParms', DecodeParm);
  PageArrPosition := FPagesCount - 1;
  SetLength(PageArr, FPagesCount);
  PageArr[PageArrPosition].PageObj := PageObj;
  PageArr[PageArrPosition].PageLink.ObjectNumber := PageObj.ID.ObjectNumber;
  PageArr[PageArrPosition].PageLink.GenerationNumber := PageObj.ID.GenerationNumber;
  Inc(PageArrPosition);
  SetCurrentPageNum(FPagesCount - 1);
  FCurrentPage.Size := psA4;
  FCurrentPage.SetFont('Arial', [], 10);
  result := (FPagesCount - 1);
end;

procedure TVPDF.AddTiffFromFile(FileName: TFileName; Compression: TVPDFImageCompressionType; PaintType:

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -