* Patch from Ondrej Pokorny to add transparency

git-svn-id: trunk@41551 -

.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

packages/fcl-pdf/examples/testfppdf.lpr

@@ -33,7 +33,8 @@ type
     FRawJPEG,
     FImageCompression,
     FTextCompression,
-    FFontCompression: boolean;
+    FFontCompression,
+    FImageTransparency: boolean;
     FNoFontEmbedding: boolean;
     FAddMetadata : Boolean;
     FSubsetFontEmbedding: boolean;
@@ -93,6 +94,8 @@ begin
     Include(lOpts,poCompressText);
   if FImageCompression then
     Include(lOpts,poCompressImages);
+  if FImageTransparency then
+    Include(lOpts,poUseImageTransparency);
   if FRawJPEG then
     Include(lOpts,poUseRawJPEG);
   if FAddMetadata then
@@ -302,7 +305,7 @@ procedure TPDFTestApp.SimpleImage(D: TPDFDocument; APage: integer);
 Var
   P: TPDFPage;
   FtTitle: integer;
-  IDX: Integer;
+  IDX, IDX_Diamond: Integer;
   W, H: Integer;
 begin
   P := D.Pages[APage];
@@ -323,6 +326,10 @@ begin
   { full size image }
   P.DrawImageRawSize(25, 130, W, H, IDX);  // left-bottom coordinate of image
   P.WriteText(145, 90, '[Full size (defined in pixels)]');
+  P.WriteText(145, 95, '+alpha-transparent overlay (if enabled)');
+
+  IDX_Diamond := D.Images.AddFromFile('diamond.png',False);
+  P.DrawImageRawSize(30, 125, D.Images[IDX_Diamond].Width, D.Images[IDX_Diamond].Height, IDX_Diamond);
 
   { quarter size image }
   P.DrawImageRawSize(25, 190, W shr 1, H shr 1, IDX); // could also have used: Integer(W div 2), Integer(H div 2)
@@ -817,6 +824,7 @@ begin
   FFontCompression := BoolFlag('f',true);
   FTextCompression := BoolFlag('t',False);
   FImageCompression := BoolFlag('i',False);
+  FImageTransparency := BoolFlag('t',False);
   FAddMetadata :=  BoolFlag('m',False);
   FRawJPEG:=BoolFlag('j',False);
 
@@ -881,6 +889,8 @@ begin
           '                disables compression. A value of 1 enables compression.');
   writeln('    -j <0|1>    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;
 

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);
+    Procedure CreateStreamedData(AUseCompression, AUseTransparency: Boolean);
-    Function WriteImageStream(AStream: TStream): int64; virtual;
+    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;
+  MS,MSMask : TMemoryStream;
-  Str : TStream;
+  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
+    CreateSream(MS, Str, FCompression);
-      begin
+    if CreateMask then
-      FCompression := icDeflate;
+      CreateSream(MSMask, StrMask, FCompressionMask);
-      Str := Tcompressionstream.create(cldefault, MS)
-      end
-    else
-      begin
-      FCompression := icNone;
-      Str := MS;
-      end;
     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
+    StreamToBuffer(MS, Str, FStreamed);
-      Str.Free;
+    if CreateMask then
-    Str := nil;
+      StreamToBuffer(MSMask, StrMask, FStreamedMask);
-    SetLength(FStreamed, MS.Size);
-    MS.Position := 0;
-    if MS.Size>0 then
-      MS.ReadBuffer(FStreamed[0], MS.Size);
   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;
+  ImageDict:=CreateGlobalXRef.Dict;
-  IDict.AddName('Type','XObject');
+  ImageDict.AddName('Type','XObject');
-  IDict.AddName('Subtype','Image');
+  ImageDict.AddName('Subtype','Image');
-  IDict.AddInteger('Width',ImgWidth);
+  ImageDict.AddInteger('Width',ImgWidth);
-  IDict.AddInteger('Height',ImgHeight);
+  ImageDict.AddInteger('Height',ImgHeight);
-  IDict.AddName('ColorSpace','DeviceRGB');
+  ImageDict.AddName('ColorSpace','DeviceRGB');
-  IDict.AddInteger('BitsPerComponent',8);
+  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);