PowerPDF new feature: Link (URI Action) annotations, by Stefan Sinne, issue #37995

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7966 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/powerpdf/PRAnnotation.pas

@@ -18,6 +18,7 @@
  *
  * 2001.07.07 Create
  * 2001.08.12 Changed the implementation of annotation.
+ * 2020.10.23 Added annotation type: Text or link annotation. (<stefan[at]smartsoftware[dot]com>)
  *
  *}
 {$IFDEF LAZ_POWERPDF}
@@ -37,10 +38,14 @@ uses
   PReport, PdfDoc, PdfFonts, PdfTypes;
 
 type
+  TPRAnnotationType = TPdfAnnotationSubType;
+
   TPRAnnotation = class(TPRItem)
   private
+    FSubType: TPRAnnotationType;
     FLines: TStrings;
     FOpened: boolean;
+    FAction: TPRAction;
     procedure SetLines(Value: TStrings);
     procedure SetText(Value: string);
     function GetText: string;
@@ -53,14 +58,17 @@ type
     {$ENDIF}
     procedure Paint; override;
     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
+    procedure SetAction(aValue: TPRAction); virtual;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property Text: string read GetText write SetText;
   published
+    property SubType: TPRAnnotationType read FSubType write FSubType default asTextNotes;
     property Caption;
     property Lines: TStrings read GetLines write SetLines;
     property Opened: boolean read FOpened write FOpened;
+    property Action: TPRAction read FAction write SetAction;
   end;
 
 implementation
@@ -97,12 +105,14 @@ constructor TPRAnnotation.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FLines := TStringList.Create;
+  FAction := TPRAction.Create;
 end;
 
 // Destroy
 destructor TPRAnnotation.Destroy;
 begin
   FLines.Free;
+  FAction.Free;
   inherited;
 end;
 
@@ -120,11 +130,16 @@ procedure TPRAnnotation.Paint;
 var
   W: Integer;
   tmpRect: TRect;
+  s: String;
 const
   PDF_ANNOT_TITLE_HEIGHT = 15;
 begin
   with Canvas do
   begin
+    if SubType = asTextNotes then
+      s := Text
+    else
+      s := Action.URI;
     tmpRect := GetClientRect;
     tmpRect.Top := PDF_ANNOT_TITLE_HEIGHT;
     InflateRect(tmpRect, -5, -1);
@@ -152,12 +167,14 @@ var
   NewRect: TRect;
 begin
   // omitting LF charactors from CRLF sequence.
-  S := Text;
-  APos := pos(#13#10, S);
-  while APos > 0 do
-  begin
-    S := Copy(S, 1, APos) + Copy(S, APos+2, Length(S) - APos-2);
+  if SubType = asTextNotes then begin
+    S := Text;
     APos := pos(#13#10, S);
+    while APos > 0 do
+    begin
+      S := Copy(S, 1, APos) + Copy(S, APos+2, Length(S) - APos-2);
+      APos := pos(#13#10, S);
+    end;
   end;
 
   // creating annotation object and setting properties.
@@ -169,12 +186,27 @@ begin
     Right := ARect.Right;
   end;
   with NewRect do
-    FAnnotation := ACanvas.PdfCanvas.Doc.CreateAnnotation(asTextNotes,
+    FAnnotation := ACanvas.PdfCanvas.Doc.CreateAnnotation(SubType,
                                             _PdfRect(Left, Top, Right, Bottom));
-  FAnnotation.AddItem('Contents', TPdfText.CreateText(S));
-  FAnnotation.AddItem('S', TPdfText.CreateText(Caption));
-  if Opened then
-    FAnnotation.AddItem('Open', TPdfBoolean.CreateBoolean(true));
+  if SubType = asTextNotes then begin
+    // Subtype Text
+    FAnnotation.AddItem('Contents', TPdfText.CreateText(S));
+    // Title key is "T", not "S"
+    //FAnnotation.AddItem('S', TPdfText.CreateText(Caption));
+    FAnnotation.AddItem('T', TPdfText.CreateText(Caption));
+    if Opened then
+      FAnnotation.AddItem('Open', TPdfBoolean.CreateBoolean(true));
+  end else begin
+    // Subtype Link
+    FAnnotation.AddItem('A', Action.GetPdfObj(ACanvas.PdfCanvas.Doc));
+    FAnnotation.AddItem('Border', TPdfArray.CreateNumArray(nil, [0, 0, 0]));
+  end;
+end;
+
+procedure TPRAnnotation.SetAction(aValue: TPRAction);
+begin
+  if not FAction.IsEqual(aValue) then
+    FAction.Assign(aValue);
 end;
 
 end.

components/powerpdf/PReport.pas

@@ -32,6 +32,7 @@
  *            added AlignJustified property to TPRLabel.
  * 2001.09.13 added ViewerPreference functions.
  *            added check functions to TPReport.
+ * 2020.10.23 added TPRAction class. (<stefan[at]smartsoftware[dot]com>)
  *
  *}
 unit PReport;
@@ -91,6 +92,7 @@ type
   TPRItem = class;
   TPROutlineEntry = class;
   TPRDestination = class;
+  TPRAction = class;
   TPROutlineRoot = class;
 
   TPRPrintPageEvent = procedure(Sender: TObject;
@@ -101,6 +103,7 @@ type
   TPRPrintChildPanelEvent = procedure(Sender: TObject; ACanvas: TPRCanvas;
                               ACol, ARow: integer; Rect: TRect) of object;
   TPrintDirection = (pdHorz, pdVert);
+  TPRActionType = TPdfActionType;
   TPRDestinationType = TPdfDestinationType;
   TPRPageLayout = TPdfPageLayout;
   TPRPageMode = TPdfPageMode;
@@ -521,6 +524,23 @@ type
     property Proportional: boolean read FProportional write SetProportional;
   end;
 
+  { TPRAction }
+  TPRAction = class(TPersistent)
+  private
+    FSubType: TPRActionType;
+    FDest: TPRDestination;
+    FURI: String;
+  protected
+    procedure AssignTo(Dest: TPersistent); override;
+  public
+    function GetPdfObj(aPdfDoc: TPdfDoc): TPdfDictionary; virtual;
+    function IsEqual(aValue: TPRAction): Boolean;
+  published
+    property SubType: TPRActionType read FSubType write FSubType default atURI;
+    //property Dest: TPRDestination read FDest;
+    Property URI: String read FURI write FURI;
+  end;
+
   { TPRDestination }
   TPRDestination = class(TObject)
   private
@@ -2631,6 +2651,49 @@ begin
   inherited;
 end;
 
+{ TPRAction }
+procedure TPrAction.AssignTo(Dest: TPersistent);
+var
+  destAction: TPrAction;
+begin
+  if Dest is TPrAction then begin
+    destAction := Dest as TPrAction;
+    destAction.SubType:=SubType;
+    destAction.URI:=URI;
+  end;
+end;
+
+function TPrAction.IsEqual(aValue: TPRAction): Boolean;
+begin
+  result := Assigned(aValue) and
+            (aValue.SubType = SubType) and
+            (aValue.URI = URI);
+end;
+
+function TPrAction.GetPdfObj(aPdfDoc: TPdfDoc): TPdfDictionary;
+var
+  objMgr: TPdfObjectMgr;
+begin
+  if Assigned(aPdfDoc) then
+    objMgr := aPdfDoc.ObjectMgr
+  else
+    objMgr := nil;
+  result := TPdfDictionary.CreateDictionary(objMgr);
+  if Assigned(objMgr) then
+    // create indirect object
+    objMgr.AddObject(result);
+  result.AddItem('Type', TPdfName.CreateName('Action'));
+  result.AddItem('S', TPdfName.CreateName(PDF_ACTION_TYPE_NAMES[Ord(SubType)]));
+  case SubType of
+    atURI:
+      begin
+        result.AddItem('URI', TPdfText.CreateText(URI))
+      end;
+    else
+      Exception.Create('Subtype ' + PDF_ACTION_TYPE_NAMES[Ord(SubType)] + ' not implemented.');
+  end;
+end;
+
 { TPRDestination }
 procedure TPRDestination.SetType(Value: TPRDestinationType);
 begin

components/powerpdf/PdfDoc.pas

@@ -37,6 +37,7 @@
  * 2001.09.08 added OpenAction function.
  *            change AddAnnotation method to CreateAnnotation.
  * 2001.09.13 added ViewerPreference functions.
+ * 2020.10.23 added action subtype helper classes. (<stefan[at]smartsoftware[dot]com>)
  *}
 {$IFDEF LAZ_POWERPDF}
 {$H+}
@@ -144,6 +145,18 @@ const
                                                        'FitBH',
                                                        'FitBV');
 
+  PDF_ACTION_TYPE_NAMES: array[0..10] of string = ('URI',
+                                                   'GoTo',
+                                                   'GoToR',
+                                                   'Launch',
+                                                   'Thread',
+                                                   'Sound',
+                                                   'Movie',
+                                                   'SetState',
+                                                   'Hide',
+                                                   'Named',
+                                                   'NOP');
+
 type
   {*
    * The pagemode determines how the document should appear when opened.
@@ -201,6 +214,22 @@ type
                         dtFitBH,
                         dtFitBV);
 
+  {*
+   * The TPdfActionType determines action subtypes:
+   *}
+  TPdfActionType = (atURI);
+                    // some more perhaps implemented later
+                    {,atGoTo,
+                    atGoToR,
+                    atLaunch,
+                    atThread,
+                    atSound,
+                    atMovie
+                    atSetState,
+                    atHide,
+                    atNamed,
+                    atNOP); }
+
   {*
    * TPdfPageLayout specifying the page layout to be used when the document is
    * opened: