From 805e2bb28dfce833fa67db5f9768570b55aa2b16 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 2 Mar 2019 12:21:28 +0000 Subject: [PATCH] * Patch from Ondrej Pokorny to add transparency git-svn-id: trunk@41551 - --- .gitattributes | 1 + packages/fcl-pdf/examples/diamond.png | Bin 0 -> 2395 bytes packages/fcl-pdf/examples/testfppdf.lpr | 14 +- packages/fcl-pdf/src/fppdf.pp | 213 +++++++++++++++++++----- 4 files changed, 184 insertions(+), 44 deletions(-) create mode 100644 packages/fcl-pdf/examples/diamond.png diff --git a/.gitattributes b/.gitattributes index 6cd8c38866..e7805b18d3 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2652,6 +2652,7 @@ packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain packages/fcl-pdf/Makefile svneol=native#text/plain packages/fcl-pdf/Makefile.fpc svneol=native#text/plain +packages/fcl-pdf/examples/diamond.png -text svneol=unset#image/png packages/fcl-pdf/examples/poppy.jpg -text packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain diff --git a/packages/fcl-pdf/examples/diamond.png b/packages/fcl-pdf/examples/diamond.png new file mode 100644 index 0000000000000000000000000000000000000000..6af20f5a5342b7036985386289891b2c30688cab GIT binary patch literal 2395 zcmaJ@dpK12AD)YGnWflhU2}}~Ntd~t5yQAOW8A9A7&I!Cxty3Cb1^d*RIW)vDs63R zx0$5$+r=s>8FGt~^^}B4q}{{{wYEgX?`YHRAHRO*dCvLX-uL~y-_Q4R&T|g1Hu)K0 zEwKm$!YII>!G>GG{H?DGKV?sjg}{x4(kDzAEZwDy=gJ`jO(5k#K!BJV39%urAR*=^ zg~0bxj(GK{&A%9n}>+<6Q^C6>W#1j5}*CFAl%kP_fQkwS?FZldNI4iE}Fa2zKl zi7E4jqJ;j5aws@)QwTp%#CH|oygUJS6%`f`LrN~75=ToERFwzrgDw^B&rcI^zz2v@ z!TMluRQhA6}8oiK3R+LmJRYXZ;fOoJH zz!6FW(s;!OG?PgUkSLT~2_Fhzc;H|@K`0bZ=@du0qpvU7k?hR?K_56rB#MiR6Md~S zneIbz@?PLFr2JShBvCGK1^;jzKg*pj1hEW`%z)&=I7r|tmx_T88>R|B?}hYPy^mbM z=e>ZR8r{ZzE@;8WQ{61djoa8W1ju7ck%%$)!REkyO;`J*|J zb*M4o#r+*yw?>y5(z_>LG|TU#to|NRCq(t6|4ghO`t*CXcS*H#CH{XMf>8xm}X(C?CyNPc?#Nj8(tb8mHr z@a>{P4p?JHsqBqAGd`jJU2|bWVM}3S-^yQpWwsBH$|Gj8r<0=m{G$LpQY2{GsvUSd z^*(nRKQwhB8Oomv^gG1!Z1CGxt}c3N)o$ArC`wH;Znhq}xUCFXmtIEO$s?R^(9x&& zWN^S%bX{E;cW+j8AzA-b-j4dhLnTKO4JL!zli6t3v}x+lxW3;as}qr6ayClP>n0nu z*`2UVVV7$6h;!o9SJ2e-4zZDy&SmXaJNsYsC3Ozx{;;wQ8R-sOxd-lc<=#nelso|6 z9mRK`wbI@tNqP@!mtpiJFOBQ822V{+=f#v+`!@z71}skBHo1@`-g!*NWUlfuXK%N% z(=z=Ds-7Q+*6z}wkGb6(GqWiS;QbXCTvH0VYglf9vYIB;$T5D-W!2Avn5HFd$z$UN zRZ07eefO7J@ateqPRv_3jkVp{4i{@|=8A%*aJ>n@Z;kGrP6G@N3VU)@E@VGXTaH(Wcpl4q`Nuj#&u)!(DK937Khgyj z1f4CW?Rt=+$s*eu&<~+DR$;siu8$nXa`N>wgOe5&TnF{@->KOt8!Jt`kq{j#(3YAv zI{d~4io`9(42xr^`#o`nb_ILbKn*!lzipW!zYDZH-J4d4DMDuVx(FUl{LybQ+qbDR zNHb=$GT&&wcgYl{Uhgmeb=!cF(ypQH3#@UZ^X607~Jcen};sCI~O=_$wFFgx$@g@unn zI&X`m0MoX`^Qccy^OeEGwsI8x?xXET`fla3Ou>}V?qj-|up|9@D zpZUp%P779)w`TFODmr3OUl_CJ7#E!^9Wr5WBU@8h?{X4cmzwf(ZiU2?lMh2^)hR%x#?o_ z)!}+C7Bwm~r|vw*a%eA8Dmumn3{e?D!`cMP<;P=7QlB8xA0%Ckl09M}xu!E4w&?7i zK#A0J0vGz_TF$l+=q3`O$tshT6Oqfyt{}Mnia+o79j`l z6?ok%d4o-?4w2OiHPe<>9ak2uqwQSbQSsI=qpEYoD|H90+E*glJky8u4pw-LR8xFw z&y{Pmw|d&DWD{n3Z%Q-)_NAK-?sziVd~(Zbdz3}a%DV22lOn%}@6$)m-yOYh{97OF zg;$kv#% Toggle use of JPEG. A value of 0' + LineEnding + ' disables use of JPEG images. A value of 1 writes jpeg file as-is'); + writeln(' -t <0|1> Toggle image transparency support. A value of 0' + LineEnding + + ' disables transparency. A value of 1 enables transparency.'); writeln(''); end; diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp index 0b6f6feb47..a74af3a383 100644 --- a/packages/fcl-pdf/src/fppdf.pp +++ b/packages/fcl-pdf/src/fppdf.pp @@ -69,7 +69,8 @@ type TPDFPageLayout = (lSingle, lTwo, lContinuous); TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels); - TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts, poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID); + TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts, + poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID, poUseImageTransparency); TPDFOptions = set of TPDFOption; EPDF = Class(Exception); @@ -889,22 +890,32 @@ type FOwnsImage: Boolean; FStreamed: TBytes; FCompression: TPDFImageCompression; + FStreamedMask: TBytes; + FCompressionMask: TPDFImageCompression; FWidth,FHeight : Integer; + function GetHasMask: Boolean; function GetHeight: Integer; function GetStreamed: TBytes; + function GetStreamedMask: TBytes; function GetWidth: Integer; procedure SetImage(AValue: TFPCustomImage); procedure SetStreamed(AValue: TBytes); + Protected + Function WriteStream(const AStreamedData: TBytes; AStream: TStream): int64; virtual; Public Destructor Destroy; override; - Procedure CreateStreamedData(AUseCompression: Boolean); - Function WriteImageStream(AStream: TStream): int64; virtual; + Procedure CreateStreamedData(AUseCompression, AUseTransparency: Boolean); + procedure SetStreamedMask(const AValue: TBytes; const ACompression: TPDFImageCompression); + Function WriteImageStream(AStream: TStream): int64; + Function WriteMaskStream(AStream: TStream): int64; function Equals(AImage: TFPCustomImage): boolean; reintroduce; Property Image : TFPCustomImage Read FImage Write SetImage; Property StreamedData : TBytes Read GetStreamed Write SetStreamed; + Property StreamedMask : TBytes Read GetStreamedMask; Property OwnsImage : Boolean Read FOwnsImage Write FOwnsImage; Property Width : Integer Read GetWidth; Property Height : Integer Read GetHeight; + Property HasMask : Boolean read GetHasMask; end; @@ -1053,7 +1064,10 @@ type procedure CreateToUnicode(const AFontNum: integer);virtual; procedure CreateFontFileEntry(const AFontNum: integer);virtual; procedure CreateCIDSet(const AFontNum: integer); virtual; - procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual; + procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer; + out ImageDict: TPDFDictionary);virtual; + procedure CreateImageMaskEntry(ImgWidth, ImgHeight, NumImg: integer; + ImageDict: TPDFDictionary);virtual; function CreateAnnotEntry(const APageNum, AnnotNum: integer): integer; virtual; function CreateCIDToGIDMap(const AFontNum: integer): integer; virtual; procedure CreatePageStream(APage : TPDFPage; PageNum: integer); @@ -2835,13 +2849,20 @@ begin if Length(FStreamed)=0 then begin if Collection.Owner is TPDFDocument then - CreateStreamedData(poCompressImages in TPDFDocument(Collection.Owner).Options) + CreateStreamedData(poCompressImages in TPDFDocument(Collection.Owner).Options, + poUseImageTransparency in TPDFDocument(Collection.Owner).Options) else - CreateStreamedData(True); + CreateStreamedData(True,True); end; Result:=FStreamed; end; +function TPDFImageItem.GetStreamedMask: TBytes; +begin + GetStreamed; // calls CreateStreamedData + Result:=FStreamedMask; +end; + function TPDFImageItem.GetHeight: Integer; begin If Assigned(FImage) then @@ -2865,6 +2886,25 @@ begin FStreamed:=AValue; end; +procedure TPDFImageItem.SetStreamedMask(const AValue: TBytes; + const ACompression: TPDFImageCompression); +begin + If AValue=FStreamedMask then exit; + SetLength(FStreamedMask,0); + FStreamedMask:=AValue; + FCompressionMask:=ACompression; +end; + +function TPDFImageItem.WriteImageStream(AStream: TStream): int64; +begin + Result:=WriteStream(FStreamed, AStream); +end; + +function TPDFImageItem.WriteMaskStream(AStream: TStream): int64; +begin + Result:=WriteStream(FStreamedMask, AStream); +end; + destructor TPDFImageItem.Destroy; begin if FOwnsImage then @@ -2872,60 +2912,101 @@ begin inherited Destroy; end; -procedure TPDFImageItem.CreateStreamedData(AUseCompression: Boolean); +procedure TPDFImageItem.CreateStreamedData(AUseCompression, + AUseTransparency: Boolean); + + function NeedsTransparency: Boolean; + var + Y, X: Integer; + begin + for Y:=0 to FHeight-1 do + for X:=0 to FWidth-1 do + begin + if Image.Colors[x,y].alpha < $FFFF then // has alpha channel + Exit(True); + end; + Result:=False; + end; + + procedure CreateSream(out MS: TMemoryStream; out Str: TStream; + out Compression: TPDFImageCompression); + begin + MS := TMemoryStream.Create; + if AUseCompression then + begin + Compression := icDeflate; + Str := Tcompressionstream.create(cldefault, MS); + end + else + begin + Compression := icNone; + Str := MS; + end; + end; + + procedure StreamToBuffer(const MS: TMemoryStream; var Str: TStream; out Buffer: TBytes); + begin + if Str<>MS then + Str.Free; + Str := nil; + SetLength(Buffer, MS.Size); + MS.Position := 0; + if MS.Size>0 then + MS.ReadBuffer(Buffer[0], MS.Size); + end; + Var X,Y : Integer; C : TFPColor; - MS : TMemoryStream; - Str : TStream; + MS,MSMask : TMemoryStream; + Str,StrMask : TStream; CWhite : TFPColor; // white color + CreateMask : Boolean; begin FillMem(@CWhite, SizeOf(CWhite), $FF); FWidth:=Image.Width; FHeight:=Image.Height; + CreateMask:=AUseTransparency and NeedsTransparency; + MS := nil; Str := nil; - MS := TMemoryStream.Create; + MSMask := nil; + StrMask := nil; try - if AUseCompression then - begin - FCompression := icDeflate; - Str := Tcompressionstream.create(cldefault, MS) - end - else - begin - FCompression := icNone; - Str := MS; - end; + CreateSream(MS, Str, FCompression); + if CreateMask then + CreateSream(MSMask, StrMask, FCompressionMask); for Y:=0 to FHeight-1 do for X:=0 to FWidth-1 do begin C:=Image.Colors[x,y]; - if C.alpha < $FFFF then // remove alpha channel - assume white background + if CreateMask then + StrMask.WriteByte(C.Alpha shr 8) + else + if (C.alpha < $FFFF) then // remove alpha channel - assume white background C := AlphaBlend(CWhite, C); Str.WriteByte(C.Red shr 8); Str.WriteByte(C.Green shr 8); Str.WriteByte(C.Blue shr 8); end; - if Str<>MS then - Str.Free; - Str := nil; - SetLength(FStreamed, MS.Size); - MS.Position := 0; - if MS.Size>0 then - MS.ReadBuffer(FStreamed[0], MS.Size); + StreamToBuffer(MS, Str, FStreamed); + if CreateMask then + StreamToBuffer(MSMask, StrMask, FStreamedMask); finally Str.Free; + StrMask.Free; MS.Free; + MSMask.Free; end; end; -function TPDFImageItem.WriteImageStream(AStream: TStream): int64; +function TPDFImageItem.WriteStream(const AStreamedData: TBytes; + AStream: TStream): int64; var Img : TBytes; begin TPDFObject.WriteString(CRLF+'stream'+CRLF,AStream); - Img:=StreamedData; + Img:=AStreamedData; Result:=Length(Img); AStream.WriteBuffer(Img[0],Result); TPDFObject.WriteString(CRLF, AStream); @@ -2956,6 +3037,11 @@ begin end; end; +function TPDFImageItem.GetHasMask: Boolean; +begin + Result := Length(FStreamedMask)>0; +end; + { TPDFImages } function TPDFImages.GetI(AIndex : Integer): TPDFImageItem; @@ -3092,7 +3178,7 @@ begin IP.Image:=I; if Not KeepImage then begin - IP.CreateStreamedData(poCompressImages in Owner.Options); + IP.CreateStreamedData(poCompressImages in Owner.Options, poUseImageTransparency in Owner.Options); IP.FImage:=Nil; // not through property, that would clear the image i.Free; end; @@ -4055,6 +4141,22 @@ begin begin if (E.FKey.Name='Name') then begin + if (TPDFObject(E.Value) is TPDFName) and (TPDFName(E.Value).Name[1]='M') then + begin + NumImg:=StrToInt(Copy(TPDFName(E.Value).Name, 2, Length(TPDFName(E.Value).Name) - 1)); + // write image stream length in xobject dictionary + ISize:=Length(Document.Images[NumImg].StreamedMask); + D:=Document.GlobalXRefs[AObject].Dict; + D.AddInteger('Length',ISize); + LastElement.Write(AStream); + case Document.Images[NumImg].FCompressionMask of + icJPEG: WriteString('/Filter /DCTDecode'+CRLF, AStream); + icDeflate: WriteString('/Filter /FlateDecode'+CRLF, AStream); + end; + WriteString('>>', AStream); + // write image stream in xobject dictionary + Document.Images[NumImg].WriteMaskStream(AStream); + end else if (TPDFObject(E.Value) is TPDFName) and (TPDFName(E.Value).Name[1]='I') then begin NumImg:=StrToInt(Copy(TPDFName(E.Value).Name, 2, Length(TPDFName(E.Value).Name) - 1)); @@ -5087,24 +5189,25 @@ begin lXRef.FStream.AddItem(TPDFCIDSet.Create(self, AFontNum)); end; -procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer); +procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer; + out ImageDict: TPDFDictionary); var N: TPDFName; - IDict,ADict: TPDFDictionary; + ADict: TPDFDictionary; i: integer; lXRef: integer; begin lXRef := GlobalXRefCount; // reference to be used later - IDict:=CreateGlobalXRef.Dict; - IDict.AddName('Type','XObject'); - IDict.AddName('Subtype','Image'); - IDict.AddInteger('Width',ImgWidth); - IDict.AddInteger('Height',ImgHeight); - IDict.AddName('ColorSpace','DeviceRGB'); - IDict.AddInteger('BitsPerComponent',8); + ImageDict:=CreateGlobalXRef.Dict; + ImageDict.AddName('Type','XObject'); + ImageDict.AddName('Subtype','Image'); + ImageDict.AddInteger('Width',ImgWidth); + ImageDict.AddInteger('Height',ImgHeight); + ImageDict.AddName('ColorSpace','DeviceRGB'); + ImageDict.AddInteger('BitsPerComponent',8); N:=CreateName('I'+IntToStr(NumImg)); // Needed later - IDict.AddElement('Name',N); + ImageDict.AddElement('Name',N); // now find where we must add the image xref - we are looking for "Resources" for i := 1 to GlobalXRefCount-1 do @@ -5125,6 +5228,27 @@ begin end; end; +procedure TPDFDocument.CreateImageMaskEntry(ImgWidth, ImgHeight, + NumImg: integer; ImageDict: TPDFDictionary); +var + N: TPDFName; + MDict: TPDFDictionary; + lXRef: integer; +begin + lXRef := GlobalXRefCount; // reference to be used later + + MDict:=CreateGlobalXRef.Dict; + MDict.AddName('Type','XObject'); + MDict.AddName('Subtype','Image'); + MDict.AddInteger('Width',ImgWidth); + MDict.AddInteger('Height',ImgHeight); + MDict.AddName('ColorSpace','DeviceGray'); + MDict.AddInteger('BitsPerComponent',8); + N:=CreateName('M'+IntToStr(NumImg)); // Needed later + MDict.AddElement('Name',N); + ImageDict.AddReference('SMask', lXRef); +end; + function TPDFDocument.CreateAnnotEntry(const APageNum, AnnotNum: integer): integer; var lDict, ADict: TPDFDictionary; @@ -5492,9 +5616,14 @@ end; procedure TPDFDocument.CreateImageEntries; Var I : Integer; + IDict : TPDFDictionary; begin for i:=0 to Images.Count-1 do - CreateImageEntry(Images[i].Width,Images[i].Height,i); + begin + CreateImageEntry(Images[i].Width,Images[i].Height,i,IDict); + if Images[i].HasMask then + CreateImageMaskEntry(Images[i].Width,Images[i].Height,i,IDict); + end; end; procedure TPDFDocument.CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary);