* PDF internal link objects, example adapted to show possibility. Fixes issue #40318

packages/fcl-pdf/examples/testfppdf.lpr

@@ -27,6 +27,8 @@ uses
 
 type
 
+  { TPDFTestApp }
+
   TPDFTestApp = class(TCustomApplication)
   private
     FPage: integer;
@@ -42,6 +44,7 @@ type
     function    SetUpDocument: TPDFDocument;
     procedure   SaveDocument(D: TPDFDocument);
     procedure   EmptyPage;
+    procedure   TableOfContents(D: TPDFDocument; APage: integer);
     procedure   SimpleText(D: TPDFDocument; APage: integer);
     procedure   SimpleLinesRaw(D: TPDFDocument; APage: integer);
     procedure   SimpleLines(D: TPDFDocument; APage: integer);
@@ -62,7 +65,7 @@ var
   Application: TPDFTestApp;
 
 const
-  cPageCount: integer = 8;
+  cPageCount: integer = 9;
 
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 var
@@ -141,6 +144,37 @@ begin
   end;
 end;
 
+procedure TPDFTestApp.TableOfContents(D: TPDFDocument; APage: integer);
+const
+  pagesarr: array [1..8] of String = ('Sample Text', 'Basic Shapes', 'Advanced Drawing',
+    'Sample Line Drawing (DrawLineStyle)', 'Sample Line Drawing (DrawLine)', 'Sample Image Support',
+    'Matrix transform', 'Landscape Page');
+var
+  P : TPDFPage;
+  FtTitle, FtText, i: integer;
+begin
+  P := D.Pages[APage];
+
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica');
+  FtText := D.AddFont('Courier');
+
+  { Page title }
+  P.SetFont(FtTitle, 23);
+  P.SetColor(clBlack, false);
+  P.WriteText(25, 20, 'Table of contents');
+
+  // -----------------------------------
+  { references to document pages }
+  P.SetFont(FtText, 12);
+  P.SetColor(clBlack, false);
+  for i := Low(pagesarr) to High(pagesarr) do
+  begin
+    P.WriteText(25, 40 + 10 * i, pagesarr[i] + StringOfChar('.', 60 - Length(pagesarr[i])) + IntToStr(i));
+    P.AddInternalLink(25, 40 + 10 * i, 160, 5, i, false);
+  end;
+end;
+
 { all units of measure are in millimeters }
 procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
 var
@@ -837,14 +871,15 @@ begin
 
     if FPage = -1 then
     begin
-      SimpleText(FDoc, 0);
-      SimpleShapes(FDoc, 1);
-      AdvancedShapes(FDoc, 2);
-      SimpleLines(FDoc, 3);
-      SimpleLinesRaw(FDoc, 4);
-      SimpleImage(FDoc, 5);
-      SampleMatrixTransform(FDoc, 6);
-      SampleLandscape(FDoc, 7);
+      TableOfContents(FDoc, 0);
+      SimpleText(FDoc, 1);
+      SimpleShapes(FDoc, 2);
+      AdvancedShapes(FDoc, 3);
+      SimpleLines(FDoc, 4);
+      SimpleLinesRaw(FDoc, 5);
+      SimpleImage(FDoc, 6);
+      SampleMatrixTransform(FDoc, 7);
+      SampleLandscape(FDoc, 8);
     end
     else
     begin

packages/fcl-pdf/src/fppdf.pp

@@ -785,6 +785,8 @@ type
     procedure CubicCurveToY(ACtrl1, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
     { Define a rectangle that becomes a clickable hotspot, referencing the URI argument. }
     Procedure AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const AURI: string; ABorder: boolean = false);
+    { Define a rectangle that becomes a clickable hotspot, referencing the document page. }
+    Procedure AddInternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const APageIndex: Integer; ABorder: boolean = false);
     { This returns the paper height, converted to whatever UnitOfMeasure is set too }
     function GetPaperHeight: TPDFFloat;
     Function HasImages : Boolean;
@@ -908,9 +910,11 @@ type
     FHeight: TPDFFloat;
     FURI: string;
     FBorder: boolean;
+    FExternalLink: Boolean;
   public
     constructor Create(const ADocument: TPDFDocument); override; overload;
-    constructor Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat; const AURI: String; const ABorder: Boolean = false); overload;
+    constructor Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat; const AURI: String; const ABorder: Boolean = false;
+      const AExternalLink: Boolean = true); overload;
   end;
 
 
@@ -2146,7 +2150,7 @@ begin
 end;
 
 constructor TPDFAnnot.Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat;
-  const AURI: String; const ABorder: Boolean);
+  const AURI: String; const ABorder: Boolean; const AExternalLink: Boolean);
 begin
   Create(ADocument);
   FLeft := ALeft;
@@ -2155,6 +2159,7 @@ begin
   FHeight := AHeight;
   FURI := AURI;
   FBorder := ABorder;
+  FExternalLink := AExternalLink;
 end;
 
 { TPDFAnnotList }
@@ -2806,6 +2811,21 @@ begin
   Annots.Add(an);
 end;
 
+procedure TPDFPage.AddInternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat;
+    const APageIndex: Integer; ABorder: boolean);
+var
+  an: TPDFAnnot;
+  p1, p2: TPDFCoord;
+begin
+  p1 := Matrix.Transform(APosX, APosY);
+  DoUnitConversion(p1);
+  p2.X := AWidth;
+  p2.Y := AHeight;
+  DoUnitConversion(p2);
+  an := TPDFAnnot.Create(Document, p1.X, p1.Y, p2.X, p2.Y, Format('[%d]', [APageIndex]), ABorder, False);
+  Annots.Add(an);
+end;
+
 function TPDFPage.GetPaperHeight: TPDFFloat;
 begin
   case FUnitOfMeasure of
@@ -5635,9 +5655,17 @@ begin
 
   ADict := CreateDictionary;
   lDict.AddElement('A', ADict);
-  ADict.AddName('Type', 'Action');
-  ADict.AddName('S', 'URI');
-  ADict.AddString('URI', an.FURI);
+  if an.FExternalLink then
+  begin
+    ADict.AddName('Type', 'Action');
+    ADict.AddName('S', 'URI');
+    ADict.AddString('URI', an.FURI);
+  end
+  else
+  begin
+    ADict.AddName('S', 'GoTo');
+    ADict.AddName('D' + an.FURI, '');
+  end;
 
   result := GlobalXRefCount-1;
 end;