View Issue Details

IDProjectCategoryView StatusLast Update
0037995Lazarus CCROtherpublic2020-10-27 22:50
ReporterStefan Sinne Assigned ToJesus Reyes  
PrioritynormalSeverityminorReproducibilityhave not tried
Status assignedResolutionopen 
Summary0037995: PowerPDF new feature: Link (URI Action) annotations
DescriptionThe three patch files contain a new feature for the powerpdf ccr package.
This will add the possibility to create an annotation of type "link" wich performs an URI action.
I will submit a PDF example as well, which was created with package lazreportpdfexport. The patch for package lazreportpdfexport will be submitted in another ticket.
TagsNo tags attached.
Widgetset
Attached Files

Relationships

related to 0037996 assignedJesus Reyes Packages Package lazreportpdfexport new feature: Create link annotation for TfrMemoView.URLInfo 

Activities

Stefan Sinne

2020-10-27 15:30

reporter  

test.pdf (2,291 bytes)
PdfDoc.pas.diff (1,988 bytes)   
Index: PdfDoc.pas
===================================================================
--- PdfDoc.pas	(revisi�n: 7790)
+++ PdfDoc.pas	(copia de trabajo)
@@ -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 @@
                                                        '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.
@@ -202,6 +215,22 @@
                         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:
    *}
PdfDoc.pas.diff (1,988 bytes)   
PRAnnotation.pas.diff (3,803 bytes)   
Index: PRAnnotation.pas
===================================================================
--- PRAnnotation.pas	(revisi�n: 7790)
+++ PRAnnotation.pas	(copia de trabajo)
@@ -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 @@
   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 @@
     {$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,6 +105,7 @@
 begin
   inherited Create(AOwner);
   FLines := TStringList.Create;
+  FAction := TPRAction.Create;
 end;
 
 // Destroy
@@ -103,6 +112,7 @@
 destructor TPRAnnotation.Destroy;
 begin
   FLines.Free;
+  FAction.Free;
   inherited;
 end;
 
@@ -120,11 +130,16 @@
 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 @@
   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 @@
     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.
PRAnnotation.pas.diff (3,803 bytes)   
PReport.pas.diff (2,974 bytes)   
Index: PReport.pas
===================================================================
--- PReport.pas	(revisi�n: 7790)
+++ PReport.pas	(copia de trabajo)
@@ -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 @@
   TPRItem = class;
   TPROutlineEntry = class;
   TPRDestination = class;
+  TPRAction = class;
   TPROutlineRoot = class;
 
   TPRPrintPageEvent = procedure(Sender: TObject;
@@ -101,6 +103,7 @@
   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 @@
     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 @@
   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
PReport.pas.diff (2,974 bytes)   

Issue History

Date Modified Username Field Change
2020-10-27 15:30 Stefan Sinne New Issue
2020-10-27 15:30 Stefan Sinne File Added: test.pdf
2020-10-27 15:30 Stefan Sinne File Added: PdfDoc.pas.diff
2020-10-27 15:30 Stefan Sinne File Added: PRAnnotation.pas.diff
2020-10-27 15:30 Stefan Sinne File Added: PReport.pas.diff
2020-10-27 16:06 Marco van de Voort Relationship added related to 0037996
2020-10-27 22:50 Jesus Reyes Assigned To => Jesus Reyes
2020-10-27 22:50 Jesus Reyes Status new => assigned