You are not logged in.
Pages: 1
Hi there,
I'm wondering if there is an option for setting some elements in the generated PDF as non-printable?
Edit: looks like layers are supported, have to find out how to set it's property and what property to what
Regards,
Last edited by Atys (2018-11-02 14:12:44)
Offline
Ok, I've zero knowledge about pdf and SynPDF, so do not expect much from me.
Here is a very rough implementation, main goal was to achieve it quickly, it would be nice if Arnaud would implement it _nicely_.
And here comes the beauty (Test it with "05 - Report created from code" / SynPdfLayers.dpr):
function TPdfDocument.CreateOptionalContentGroup(ParentContentGroup: TPdfOptionalContentGroup; const Title: string; Visible: boolean; PrintLayer: boolean = True): TPdfOptionalContentGroup;
var
Dico, DicoD, DicU, DicASEntry, DicPr: TPdfDictionary;
Arr, ArrOCGs, ArrAS: TPdfArray;
i: integer;
function FindParentContentGroupArray(Current: TPdfArray): TPdfArray;
var
i: integer;
begin
Result := nil;
if Current = nil then
exit;
for i := 0 to Current.ItemCount - 1 do
if Current.Items[i] = ParentContentGroup then
begin
if (i < Current.ItemCount - 1) and Current.Items[i + 1].InheritsFrom(TPdfArray) then
Result := TPdfArray(Current.Items[i + 1])
else
begin
Result := TPdfArray.Create(FXRef);
Current.InsertItem(i + 1, Result);
end;
exit;
end;
for i := 0 to Current.ItemCount - 1 do
if Current.Items[i].InheritsFrom(TPdfArray) then
begin
Result := FindParentContentGroupArray(TPdfArray(Current.Items[i]));
if Result <> nil then
exit;
end;
end;
begin
if FUseOptionalContent then
begin
Result := TPdfOptionalContentGroup.Create(FXRef);
FXRef.AddObject(Result);
Result.AddItem('Type', 'OCG');
Result.AddItemTextString('Name', Title);
Dico := FRoot.Data.PdfDictionaryByName('OCProperties');
if not PrintLayer then
begin
DicU := TPdfDictionary.Create(FXRef);
DicPr := TPdfDictionary.Create(FXRef);
DicPr.AddItem('PrintState', 'OFF');
DicU.AddItem('Print', DicPr);
Result.AddItem('Usage', DicU);
end;
if Dico <> nil then
begin
DicoD := Dico.PdfDictionaryByName('D');
if DicoD <> nil then
begin
Arr := DicoD.PdfArrayByName('Order');
if ParentContentGroup <> nil then
Arr := FindParentContentGroupArray(Arr);
if Arr <> nil then
Arr.AddItem(Result);
if not Visible then
begin
Arr := DicoD.PdfArrayByName('OFF');
if Arr <> nil then
Arr.AddItem(Result);
end;
if not PrintLayer then
begin
ArrAS := DicoD.PdfArrayByName('AS');
if ArrAS = nil then
begin
ArrAS := TPdfArray.Create(FXRef);
DicASEntry := TPdfDictionary.Create(FXRef);
DicASEntry.AddItem('Event', 'Print');
DicASEntry.AddItem('Category', TPdfArray.CreateNames(FXRef, ['Print']));
ArrOCGs := TPdfArray.Create(FXRef);
ArrOCGs.AddItem(Result);
DicASEntry.AddItem('OCGs', ArrOCGs);
ArrAS.AddItem(DicASEntry);
DicoD.AddItem('AS', ArrAS);
end
else
begin
for i := 0 to ArrAS.ItemCount - 1 do
begin
if TPdfName(TPdfDictionaryElement(TPdfDictionary(ArrAS.Items[i]).ValueByName('Event'))).Value = 'Print' then
begin
ArrOCGs := TPdfArray(TPdfDictionary(ArrAS.Items[i]).ValueByName('OCGs'));
if ArrOCGs <> nil then
ArrOCGs.AddItem(Result);
end;
end;
end;
end;
Arr := Dico.PdfArrayByName('OCGs');
if Arr <> nil then
Arr.AddItem(Result);
end;
end;
end
else
Result := nil;
end;
Last edited by Atys (2018-11-02 19:20:00)
Offline
Does not work with VCLCanvas
How to flush VCLCanvas' buffer before 'EMC'?
Last edited by Atys (2018-11-02 22:30:06)
Offline
Solved with GDIComment. Phew, I'm supporting myself very good. This is awesome, I'm wondering if anyone anytime implements this.
Offline
I've no better idea for these two methods then vclcanvas is not our class.
(Are the RawUTF8() casts okay?)
procedure TPdfDocumentGDI.VclCanvasBeginMarkedContent(Group: TPdfOptionalContentGroup);
var
Resources, Properties: TPdfDictionary;
ID: PDFString;
begin
if not UseOptionalContent then
exit;
if Group <> nil then
begin
ID := 'oc' + UInt32ToPDFString(Group.ObjectNumber);
// register Group in page resources properties
Resources := Canvas.FPage.PdfDictionaryByName('Resources');
if Resources <> nil then
begin
Properties := Resources.PdfDictionaryByName('Properties');
if Properties = nil then
begin
Properties := TPdfDictionary.Create(Canvas.fDoc.FXRef);
Resources.AddItem('Properties', Properties);
end;
if Properties <> nil then
Properties.AddItem(ID, Group);
end;
GDICommentCustomCode(VCLCanvas.Handle, RawUTF8('/OC /' + ID + ' BDC'#10));
end
else
GDICommentCustomCode(VCLCanvas.Handle, RawUTF8('/OC BMC'#10));
end;
procedure TPdfDocumentGDI.VclCanvasEndMarkedContent;
begin
if UseOptionalContent then
GDICommentCustomCode(VCLCanvas.Handle, RawUTF8('EMC'#10));
end;
I made it general, instead of two messages with begin/end content.
procedure GDICommentCustomCode(MetaHandle: HDC; const aCustomCode: RawUTF8);
var
Data: RawByteString;
d: PAnsiChar;
L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
L := length(aCustomCode);
SetLength(Data, L + 1);
d := Pointer(Data);
d^ := AnsiChar(pgCustomCode);
Move(Pointer(aCustomCode)^, d[1], L);
Windows.GdiComment(MetaHandle, L + 1, d);
end;
some changes:
TPdfGDIComment = (pgcOutline, pgcBookmark, pgcLink, pgCustomCode);
procedure TPdfEnum.HandleComment(Kind: TPdfGDIComment; P: PAnsiChar; Len: integer);
.
.
.
pgCustomCode:
if Len > 0 then
begin
SetString(Text, P, Len);
Canvas.Contents.Writer.Add(Text);
end;
Last edited by Atys (2018-11-03 12:06:51)
Offline
Demo code:
obPDF := TPdfDocumentGDI.Create;
try
obPDF.UseOptionalContent := True;
obNonPrintableLayer := obPDF.CreateOptionalContentGroup(nil, 'Non-Printable', True, False);
try
obPDF.AddPage;
obPDF.VCLCanvasBeginMarkedContent(obNonPrintableLayer);
c := obPDF.VCLCanvas;
c.Font.Name := 'Times new roman';
c.Font.Size := 32;
c.Font.Style := [fsBold, fsItalic];
c.Font.Color := clNavy;
c.TextOut(100, 100, 'Hello 1');
obPDF.VclCanvasEndMarkedContent;
c.TextOut(40, 40, 'Hello 2');
obPDF.SaveToFile(ChangeFileExt(ExeVersion.ProgramFileName, '.pdf'));
finally
obPDF.Free;
end;
Last edited by Atys (2018-11-03 12:13:39)
Offline
I am not sure I understand the need of this, and I honnestly don't have much time to investigate...
Tricking the GDIComment may be the right thing to do, but it sounds to me not as a clean way: I am always wondering if it may hurt some existing code.
The main problem with accepting such requests is that it is difficult to verify it won't break existing code used by other users - I have seen so many regressions when merging external code within SynPDF...
Offline
Pages: 1