View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0037995 | Lazarus CCR | Other | public | 2020-10-27 15:30 | 2021-01-20 00:15 |
Reporter | Stefan Sinne | Assigned To | Jesus Reyes | ||
Priority | normal | Severity | minor | Reproducibility | have not tried |
Status | resolved | Resolution | fixed | ||
Summary | 0037995: PowerPDF new feature: Link (URI Action) annotations | ||||
Description | The 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. | ||||
Tags | No tags attached. | ||||
Widgetset | |||||
Attached Files |
|
related to | 0037996 | resolved | Jesus Reyes | Packages | Package lazreportpdfexport new feature: Create link annotation for TfrMemoView.URLInfo |
|
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: *} 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. 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 |
|
Patch Applied in r7966, thank you. |
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 |
2021-01-20 00:15 | Jesus Reyes | Status | assigned => resolved |
2021-01-20 00:15 | Jesus Reyes | Resolution | open => fixed |
2021-01-20 00:15 | Jesus Reyes | Note Added: 0128439 |