Browse Source

fcl-image: added BigTif and LabA color support

(cherry picked from commit 8c2bb60cc8dfd39fa6aeeece491c424780e79fe4)
Massimo Magnano 2 years ago
parent
commit
d24b89fbd3
2 changed files with 301 additions and 130 deletions
  1. 283 112
      packages/fcl-image/src/fpreadtiff.pas
  2. 18 18
      packages/fcl-image/src/fptiffcmn.pas

+ 283 - 112
packages/fcl-image/src/fpreadtiff.pas

@@ -28,18 +28,16 @@
 
  ToDo:
    Compression: FAX, Jpeg...
-   Color format: YCbCr, Lab...
+   Color format: YCbCr
    PlanarConfiguration: 2 (one chunk for each channel)
-   bigtiff 64bit offsets
    XMP tag 700
    ICC profile tag 34675
 
  Not to do:
    Separate mask (deprecated)
 
- 2023-07  - Massimo Magnano
-          - added Resolution support
-
+ 2023-07  - Massimo Magnano added Resolution support
+ 2023-08  - Massimo Magnano added BigTif and LabA color support
 }
 unit FPReadTiff;
 
@@ -50,7 +48,7 @@ unit FPReadTiff;
 interface
 
 uses
-  Math, Classes, SysUtils, ctypes, zinflate, zbase, FPimage, FPTiffCmn;
+  Math, Classes, SysUtils, ctypes, zinflate, zbase, FPimage, FPColorSpace, FPTiffCmn;
 
 type
   TFPReaderTiff = class;
@@ -63,7 +61,7 @@ type
   TFPReaderTiff = class(TFPCustomImageReader)
   private
     FCheckIFDOrder: TTiffCheckIFDOrder;
-    FFirstIFDStart: DWord;
+    FFirstIFDStart: SizeUInt;
     FOnCreateImage: TTiffCreateCompatibleImgEvent;
     FReverserEndian: boolean;
     {$ifdef FPC_Debug_Image}
@@ -71,37 +69,44 @@ type
     {$endif}
     FIFDList: TFPList;
     FReverseEndian: Boolean;
-    fStartPos: int64;
+    fStartPos: SizeUInt;
     s: TStream;
+    FBigTiff: Boolean;
+
+  protected
     function GetImages(Index: integer): TTiffIFD;
     procedure TiffError(Msg: string);
-    procedure SetStreamPos(p: DWord);
-    function ReadTiffHeader(QuickTest: boolean; out IFDStart: DWord): boolean; // returns IFD: offset to first IFD
-    function ReadIFD(Start: DWord; IFD: TTiffIFD): DWord;// Image File Directory
+    procedure SetStreamPos(p: SizeUInt);
+    function ReadTiffHeader(QuickTest: boolean; out IFDStart: SizeUInt): boolean; virtual; // returns IFD: offset to first IFD
+    function ReadIFD(Start: SizeUInt; IFD: TTiffIFD): SizeUInt;// Image File Directory
     function ReadByte: Byte;
     function ReadWord: Word;
     function ReadDWord: DWord;
-    procedure ReadValues(StreamPos: DWord;
-                         out EntryType: word; out EntryCount: DWord;
+    function ReadQWord: SizeUInt;
+    procedure ReadValues(StreamPos: SizeUInt;
+                         out EntryType: word; out EntryCount: SizeUInt;
                          out Buffer: Pointer; out ByteCount: PtrUInt);
-    procedure ReadShortOrLongValues(StreamPos: DWord;
-                                    out Buffer: PDWord; out Count: DWord);
-    procedure ReadShortValues(StreamPos: DWord;
-                              out Buffer: PWord; out Count: DWord);
+    procedure ReadShortOrLongValues(StreamPos: SizeUInt;
+                                    out Buffer: Pointer; out Count: SizeUInt);
+    procedure ReadShortValues(StreamPos: SizeUInt;
+                              out Buffer: PWord; out Count: SizeUInt);
     procedure ReadImageSampleProperties(IFD: TTiffIFD; out AlphaChannel: integer; out PremultipliedAlpha: boolean;
-      out SampleCnt: DWord; out SampleBits: PWord; out SampleBitsPerPixel: DWord;
-      out PaletteCnt: DWord; out PaletteValues: PWord);
+      out SampleCnt: SizeUInt; out SampleBits: PWord; out SampleBitsPerPixel: DWord;
+      out PaletteCnt: SizeUInt; out PaletteValues: PWord);
     procedure ReadImgValue(BitCount: Word;
       var Run: Pointer; var BitPos: Byte; FillOrder: DWord;
       Predictor: word; var LastValue: word; out Value: Word);
     function FixEndian(w: Word): Word; inline;
     function FixEndian(d: DWord): DWord; inline;
+    {$ifdef CPU64}
+    function FixEndian(q: QWord): QWord; inline;
+    {$endif}
     procedure SetFPImgExtras(CurImg: TFPCustomImage; IFD: TTiffIFD);
     procedure DecodePackBits(var Buffer: Pointer; var Count: PtrInt);
     procedure DecodeLZW(var Buffer: Pointer; var Count: PtrInt);
     procedure DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; ExpectedCount: PtrInt);
-  protected
     procedure ReadDirectoryEntry(var EntryTag: Word; IFD: TTiffIFD); virtual;
+    function ReadEntryOffset: SizeUInt;
     function ReadEntryUnsigned: DWord;
     function ReadEntrySigned: Cint32;
     function ReadEntryRational: TTiffRational;
@@ -133,10 +138,11 @@ type
     procedure LoadImageFromStream(Index: integer); // call LoadIFDsFromStream before
     procedure LoadImageFromStream(IFD: TTiffIFD);  // call LoadIFDsFromStream before
     procedure ReleaseStream;
-    property StartPos: int64 read fStartPos;
+    property StartPos: SizeUInt read fStartPos;
     property ReverserEndian: boolean read FReverserEndian;
     property TheStream: TStream read s;
-    property FirstIFDStart: DWord read FFirstIFDStart;
+    property FirstIFDStart: SizeUInt read FFirstIFDStart;
+    property BigTiff: Boolean read FBigTiff;
   end;
 
 procedure DecompressPackBits(Buffer: Pointer; Count: PtrInt;
@@ -162,17 +168,26 @@ function TFPReaderTiff.FixEndian(w: Word): Word; inline;
 begin
   Result:=w;
   if FReverseEndian then
-    Result:=((Result and $ff) shl 8) or (Result shr 8);
+    //Result:=((Result and $ff) shl 8) or (Result shr 8);
+    Result:= SwapEndian(w);
 end;
 
 function TFPReaderTiff.FixEndian(d: DWord): DWord; inline;
 begin
   Result:=d;
   if FReverseEndian then
-    Result:=((Result and $ff) shl 24)
+    (*Result:=((Result and $ff) shl 24)
           or ((Result and $ff00) shl 8)
           or ((Result and $ff0000) shr 8)
-          or (Result shr 24);
+          or (Result shr 24);*)
+    Result:= SwapEndian(d);
+end;
+
+function TFPReaderTiff.FixEndian(q: QWord): QWord;
+begin
+  Result:=q;
+  if FReverseEndian
+  then Result:= SwapEndian(q);
 end;
 
 procedure TFPReaderTiff.TiffError(Msg: string);
@@ -190,12 +205,12 @@ end;
 
 procedure TFPReaderTiff.ReadImageSampleProperties(IFD: TTiffIFD;
   out AlphaChannel: integer; out PremultipliedAlpha: boolean;
-  out SampleCnt: DWord; out SampleBits: PWord; out SampleBitsPerPixel: DWord;
-  out PaletteCnt: DWord; out PaletteValues: PWord);
+  out SampleCnt: SizeUInt; out SampleBits: PWord; out SampleBitsPerPixel: DWord;
+  out PaletteCnt: SizeUInt; out PaletteValues: PWord);
 var
   BytesPerPixel: Word;
   i: Integer;
-  ExtraSampleCnt, RegularSampleCnt: DWord;
+  ExtraSampleCnt, RegularSampleCnt: SizeUInt;
   ExtraSamples: PWord;
 begin
   ReadShortValues(IFD.BitsPerSample, SampleBits, SampleCnt);
@@ -320,7 +335,27 @@ begin
       IFD.GreenBits:=SampleBits[1]; //magenta
       IFD.BlueBits:=SampleBits[2];   //yellow
       IFD.GrayBits:=SampleBits[3];  //black
+      PremultipliedAlpha:= false;
     end;
+  8,9:
+    begin
+      if (RegularSampleCnt<>1) and (RegularSampleCnt<>3) then
+        TiffError('L*a*b* colorspace needs either one component for grayscale or three components, but found '+inttostr(RegularSampleCnt));
+      if RegularSampleCnt = 3 then
+      begin
+        IFD.GreenBits:=SampleBits[0];
+        if (IFD.GreenBits <> 8) and (IFD.GreenBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component');
+        IFD.RedBits:=SampleBits[1];
+        IFD.BlueBits:=SampleBits[2]; //in fact inverse blue so more like yellow
+        if ((IFD.RedBits <> 8) and (IFD.RedBits <> 16))
+        or ((IFD.BlueBits <> 8) and (IFD.BlueBits <> 16)) then TiffError('Only 8 bit and 16 bit depth allowed for a* and b* component');
+      end else
+      begin
+        IFD.GrayBits:=SampleBits[0];
+        if (IFD.GrayBits <> 8) and (IFD.GrayBits <> 16) then TiffError('Only 8 bit and 16 bit depth allowed for L* component');
+      end;
+      PremultipliedAlpha:= false;
+    end
   else
     TiffError('Photometric interpretation not handled (' + inttostr(IFD.PhotoMetricInterpretation)+')');
   end;
@@ -460,7 +495,7 @@ begin
   end;
 end;
 
-procedure TFPReaderTiff.SetStreamPos(p: DWord);
+procedure TFPReaderTiff.SetStreamPos(p: SizeUInt);
 var
   NewPosition: int64;
 begin
@@ -503,7 +538,7 @@ end;
 procedure TFPReaderTiff.LoadIFDsFromStream;
 var
   i,j: Integer;
-  IFDStart: DWord;
+  IFDStart: SizeUInt;
   IFD: TTiffIFD;
 begin
   IFDStart:=FirstIFDStart;
@@ -553,47 +588,54 @@ begin
   Result:=ImageList.Count;
 end;
 
-function TFPReaderTiff.ReadTiffHeader(QuickTest: boolean; out IFDStart: DWord): boolean;
+function TFPReaderTiff.ReadTiffHeader(QuickTest: boolean; out IFDStart: SizeUInt): boolean;
 var
   ByteOrder: String;
   BigEndian: Boolean;
   FortyTwo: Word;
+  TIFHeader: TTiffHeader;
 begin
   Result:=false;
-  // read byte order  II low endian, MM big endian
-  ByteOrder:='  ';
-  s.Read(ByteOrder[1],2);
-  //debugln(['TForm1.ReadTiffHeader ',dbgstr(ByteOrder)]);
-  if ByteOrder='II' then
-    BigEndian:=false
-  else if ByteOrder='MM' then
-    BigEndian:=true
-  else if QuickTest then
-    exit
-  else
-    TiffError('expected II or MM');
+
+  s.Read(TIFHeader, sizeof(TTiffHeader));
+
+  if TIFHeader.ByteOrder=TIFF_ByteOrderBIG
+  then BigEndian:=true
+  else if TIFHeader.ByteOrder=TIFF_ByteOrderNOBIG
+       then BigEndian:=false
+       else if QuickTest
+            then exit
+            else TiffError('ByteOrder expected II or MM');
+
   FReverseEndian:={$ifdef FPC_BIG_ENDIAN}not{$endif} BigEndian;
   {$ifdef FPC_Debug_Image}
   if Debug then
     writeln('TFPReaderTiff.ReadTiffHeader Endian Big=',BigEndian,' ReverseEndian=',FReverseEndian);
   {$endif}
-  // read magic number 42
-  FortyTwo:=ReadWord;
-  if FortyTwo<>42 then begin
-    if QuickTest then
-      exit
-    else
-      TiffError('expected 42, because of its deep philosophical impact, but found '+IntToStr(FortyTwo));
+
+  FBigTiff:=false;
+  case TIFHeader.Version of
+  42 : IFDStart:=TIFHeader.IFDStart;
+  43 : {$ifdef CPU64}
+       begin
+         IFDStart:=ReadQWord;
+         FBigTiff:=true;
+       end;
+       {$else}
+       TiffError('Big Tiff supported only on 64 bit architecture');
+       {$endif}
+  else if QuickTest
+       then exit
+       else TiffError('Version expected 42 or 43, because of its deep philosophical impact, but found '+IntToStr(TIFHeader.Version));
   end;
-  // read offset to first IFD
-  IFDStart:=ReadDWord;
+
   //debugln(['TForm1.ReadTiffHeader IFD=',IFD]);
   Result:=true;
 end;
 
-function TFPReaderTiff.ReadIFD(Start: DWord; IFD: TTiffIFD): DWord;
+function TFPReaderTiff.ReadIFD(Start: SizeUInt; IFD: TTiffIFD): SizeUInt;
 var
-  Count: Word;
+  Count: SizeUInt;
   i: Integer;
   EntryTag: Word;
   p: Int64;
@@ -606,12 +648,18 @@ begin
   Result:=0;
   SetStreamPos(Start);
   IFD.IFDStart:=Start;
-  Count:=ReadWord;
+
+  if FBigTiff
+  then Count:=ReadQWord
+  else Count:=ReadWord;
+
   EntryTag:=0;
   p:=s.Position;
   for i:=1 to Count do begin
     ReadDirectoryEntry(EntryTag, IFD);
-    inc(p,12);
+    if FBigTiff
+    then inc(p,20)
+    else inc(p,12);
     s.Position:=p;
   end;
 
@@ -635,7 +683,7 @@ begin
   end;
 
   // read start of next IFD
-  IFD.IFDNext:= ReadDWord;
+  IFD.IFDNext:= ReadEntryOffset;
   Result:= IFD.IFDNext;
 end;
 
@@ -648,12 +696,12 @@ var
   UValue: DWord;
   SValue: integer;
   WordBuffer: PWord;
-  Count: DWord;
+  Count: SizeUInt;
   i: Integer;
 
-  function GetPos: DWord;
+  function GetPos: SizeUInt;
   begin
-     Result:=DWord(s.Position-fStartPos-2)
+     Result:=SizeUInt(s.Position-fStartPos-2)
   end;
 
 begin
@@ -803,6 +851,8 @@ begin
         3: write('3=Palette color');
         4: write('4=Transparency Mask');
         5: write('5=CMYK 8bit');
+        8: write('8=L*a*b* with a and b [-128;127]');
+        9: write('9=L*a*b* with a and b [0;255]');
         end;
         writeln;
       end;
@@ -1396,8 +1446,8 @@ begin
   else
     begin
       EntryType:=ReadWord;
-      EntryCount:=ReadDWord;
-      EntryStart:=ReadDWord;
+      EntryCount:=ReadEntryOffset;
+      EntryStart:=ReadEntryOffset;
       if (EntryType=0) and (EntryCount=0) and (EntryStart=0) then ;
       {$ifdef FPC_Debug_Image}
       if Debug then
@@ -1407,14 +1457,21 @@ begin
   end;
 end;
 
+function TFPReaderTiff.ReadEntryOffset: SizeUInt;
+begin
+  if FBigTiff
+  then Result :=ReadQWord
+  else Result :=ReadDWord;
+end;
+
 function TFPReaderTiff.ReadEntryUnsigned: DWord;
 var
-  EntryCount: LongWord;
+  EntryCount: SizeUInt;
   EntryType: Word;
 begin
   Result:=0;
   EntryType:=ReadWord;
-  EntryCount:=ReadDWord;
+  EntryCount:=ReadEntryOffset;
   if EntryCount<>1 then
     TiffError('EntryCount=1 expected, but found '+IntToStr(EntryCount));
   //writeln('TFPReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]);
@@ -1438,12 +1495,12 @@ end;
 
 function TFPReaderTiff.ReadEntrySigned: Cint32;
 var
-  EntryCount: LongWord;
+  EntryCount: SizeUInt;
   EntryType: Word;
 begin
   Result:=0;
   EntryType:=ReadWord;
-  EntryCount:=ReadDWord;
+  EntryCount:=ReadEntryOffset;
   if EntryCount<>1 then
     TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount));
   //writeln('TFPReaderTiff.ReadEntrySigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]);
@@ -1479,13 +1536,13 @@ end;
 
 function TFPReaderTiff.ReadEntryRational: TTiffRational;
 var
-  EntryCount: LongWord;
-  EntryStart: LongWord;
+  EntryCount,
+  EntryStart: SizeUInt;
   EntryType: Word;
 begin
   Result:=TiffRational0;
   EntryType:=ReadWord;
-  EntryCount:=ReadDWord;
+  EntryCount:=ReadEntryOffset;
   if EntryCount<>1 then
     TiffError('EntryCount+1 expected, but found '+IntToStr(EntryCount));
   //writeln('TFPReaderTiff.ReadEntryUnsigned Tag=',EntryTag,' Type=',EntryType,' Count=',EntryCount,' ValuesStart=',EntryStart]);
@@ -1503,10 +1560,13 @@ begin
       Result.Numerator:=ReadDWord;
     end;
   5: begin
-      // rational: Two longs: numerator + denominator
-      // this does not fit into 4 bytes
-      EntryStart:=ReadDWord;
-      SetStreamPos(EntryStart);
+      if not(FBigTiff) then
+      begin
+        // rational: Two longs: numerator + denominator
+        // this does not fit into 4 bytes
+        EntryStart:=ReadEntryOffset;
+        SetStreamPos(EntryStart);
+      end;
       Result.Numerator:=ReadDWord;
       Result.Denominator:=ReadDWord;
     end;
@@ -1518,27 +1578,34 @@ end;
 function TFPReaderTiff.ReadEntryString: AnsiString;
 var
   EntryType: Word;
-  EntryCount: LongWord;
-  EntryStart: LongWord;
+  EntryCount,
+  EntryStart: SizeUInt;
+  MaxByteCount:Byte;
+
 begin
   Result:='';
   EntryType:=ReadWord;
   if EntryType<>2 then
     TiffError('asciiz expected, but found '+IntToStr(EntryType));
-  EntryCount:=ReadDWord;
+  EntryCount:=ReadEntryOffset;
   SetLength(Result,EntryCount-1);
-  if EntryCount>4 then begin
-    // long string -> next 4 DWord is the offset
-    EntryStart:=ReadDWord;
+
+  if FBigTiff
+  then MaxByteCount :=8
+  else MaxByteCount :=4;
+
+  if EntryCount>MaxByteCount then begin
+    // long string -> next Data is the offset
+    EntryStart:=ReadEntryOffset;
     SetStreamPos(EntryStart);
     s.Read(Result[1],EntryCount-1);
   end else begin
-    // short string -> stored directly in the next 4 bytes
+    // short string -> stored directly in the next MaxByteCount bytes
     if Result<>'' then
       s.Read(Result[1],length(Result));
-    // skip rest of 4 bytes
-    if length(Result)<4 then
-      s.Read(EntryStart,4-length(Result));
+    // skip rest of MaxByteCount bytes
+    if length(Result)<MaxByteCount then
+      s.Read(EntryStart,MaxByteCount-length(Result));
   end;
 end;
 
@@ -1557,10 +1624,22 @@ begin
   Result:=FixEndian(s.ReadDWord);
 end;
 
-procedure TFPReaderTiff.ReadValues(StreamPos: DWord; out EntryType: word; out
-  EntryCount: DWord; out Buffer: Pointer; out ByteCount: PtrUInt);
+
+function TFPReaderTiff.ReadQWord: SizeUInt;
+begin
+  {$ifdef CPU64}
+   Result:=FixEndian(s.ReadQWord);
+  {$else}
+   Result:=FixEndian(s.ReadDWord);
+  {$endif}
+end;
+
+procedure TFPReaderTiff.ReadValues(StreamPos: SizeUInt; out EntryType: word; out
+  EntryCount: SizeUInt; out Buffer: Pointer; out ByteCount: PtrUInt);
 var
-  EntryStart: DWord;
+  EntryStart: SizeUInt;
+  MaxByteCount:Byte;
+
 begin
   Buffer:=nil;
   ByteCount:=0;
@@ -1569,7 +1648,7 @@ begin
   SetStreamPos(StreamPos);
   ReadWord; // skip tag
   EntryType:=ReadWord;
-  EntryCount:=ReadDWord;
+  EntryCount:=ReadEntryOffset;
   if EntryCount=0 then exit;
   case EntryType of
   1,6,7: ByteCount:=EntryCount; // byte
@@ -1579,19 +1658,26 @@ begin
   5,10: ByteCount:=8*EntryCount; // rational
   11: ByteCount:=4*EntryCount; // single
   12: ByteCount:=8*EntryCount; // double
+  16,17,18: ByteCount:=8*EntryCount; // 64 Bit Integer
   else
     TiffError('invalid EntryType '+IntToStr(EntryType));
   end;
-  if ByteCount>4 then begin
-    EntryStart:=ReadDWord;
+
+  if FBigTiff
+  then MaxByteCount :=8
+  else MaxByteCount :=4;
+
+  if ByteCount>MaxByteCount then
+  begin
+    EntryStart:=ReadEntryOffset;
     SetStreamPos(EntryStart);
   end;
   GetMem(Buffer,ByteCount);
   s.Read(Buffer^,ByteCount);
 end;
 
-procedure TFPReaderTiff.ReadShortOrLongValues(StreamPos: DWord; out
-  Buffer: PDWord; out Count: DWord);
+procedure TFPReaderTiff.ReadShortOrLongValues(StreamPos: SizeUInt; out
+  Buffer: Pointer; out Count: SizeUInt);
 var
   p: Pointer;
   ByteCount: PtrUInt;
@@ -1604,27 +1690,38 @@ begin
   try
     ReadValues(StreamPos,EntryType,Count,p,ByteCount);
     if Count=0 then exit;
-    if EntryType=3 then begin
-      // short
-      GetMem(Buffer,SizeOf(DWord)*Count);
-      for i:=0 to Count-1 do
-        Buffer[i]:=FixEndian(PWord(p)[i]);
-    end else if EntryType=4 then begin
-      // long
+    Case EntryType of
+    3: begin // short
+         GetMem(Buffer,SizeOf(DWord)*Count);
+         for i:=0 to Count-1 do
+           PWord(Buffer)[i]:=FixEndian(PWord(p)[i]);
+       end;
+    4:begin // long
+        Buffer:=p;
+        p:=nil;
+        if FReverseEndian then
+        for i:=0 to Count-1 do
+          PDWord(Buffer)[i]:=FixEndian(PDWord(Buffer)[i]);
+      end;
+    {$ifdef CPU64}
+    16,17,18:begin
       Buffer:=p;
       p:=nil;
       if FReverseEndian then
-        for i:=0 to Count-1 do
-          Buffer[i]:=FixEndian(PDWord(Buffer)[i]);
-    end else
+      for i:=0 to Count-1 do
+        PQWord(Buffer)[i]:=FixEndian(PQWord(Buffer)[i]);
+      end;
+    {$endif}
+    else
       TiffError('only short or long allowed');
+    end;
   finally
     if p<>nil then FreeMem(p);
   end;
 end;
 
-procedure TFPReaderTiff.ReadShortValues(StreamPos: DWord; out Buffer: PWord;
-  out Count: DWord);
+procedure TFPReaderTiff.ReadShortValues(StreamPos: SizeUInt; out Buffer: PWord;
+  out Count: SizeUInt);
 var
   p: Pointer;
   ByteCount: PtrUInt;
@@ -1667,11 +1764,11 @@ end;
 
 procedure TFPReaderTiff.LoadImageFromStream(IFD: TTiffIFD);
 var
-  SampleCnt: DWord;
+  SampleCnt: SizeUInt;
   SampleBits: PWord;
   ChannelValues, LastChannelValues: array of word;
 
-  PaletteCnt,PaletteStride: DWord;
+  PaletteCnt,PaletteStride: SizeUInt;
   PaletteValues: PWord;
 
   AlphaChannel: integer;
@@ -1686,15 +1783,80 @@ var
       LastChannelValues[Channel] := 0;
   end;
 
+  procedure GetPixelAsLab(out lab: TLabA);
+  begin
+    lab.L := 0;
+    lab.a := 0;
+    lab.b := 0;
+    lab.alpha := 1;
+
+    case IFD.PhotoMetricInterpretation of
+    8: begin
+         case IFD.GrayBits of
+           8,16: lab.L := ChannelValues[0]*(100/65535);
+           0:begin
+               lab.L := ChannelValues[0]*(100/65535);
+               case IFD.RedBits of
+                 16: lab.a := SmallInt(ChannelValues[1])/256;
+                 8: lab.a := ShortInt(ChannelValues[1] shr 8);
+               end;
+               case IFD.BlueBits of
+                 16: lab.b := SmallInt(ChannelValues[2])/256;
+                 8: lab.b := ShortInt(ChannelValues[2] shr 8);
+               end;
+             end;
+         end;
+       end;
+    9: begin
+         case IFD.GrayBits of
+           16: lab.L := ChannelValues[0]*(100/65280);
+           8: lab.L := ChannelValues[0]*(100/65535);
+           0:begin
+               case IFD.GreenBits of
+                 16: lab.L := ChannelValues[0]*(100/65280);
+                 8: lab.L := ChannelValues[0]*(100/65535);
+               end;
+               case IFD.RedBits of
+                 16: lab.a := (ChannelValues[1]-32768)/256;
+                 8: lab.a := (ChannelValues[1] shr 8)-128;
+               end;
+               case IFD.BlueBits of
+                 16: lab.b := (ChannelValues[2]-32768)/256;
+                 8: lab.b := (ChannelValues[2] shr 8)-128;
+               end;
+             end;
+         end;
+       end;
+     //10: ITULAB: ITU L*a*b*
+     //32844: LOGL: CIE Log2(L)
+     //32845: LOGLUV: CIE Log2(L) (u',v')
+    else
+      TiffError('PhotometricInterpretation='+IntToStr(IFD.PhotoMetricInterpretation)+' not supported');
+    end;
+
+    if AlphaChannel >= 0 then
+      lab.alpha:= ChannelValues[AlphaChannel]/65535;
+  end;
+
   function ReadNextColor(var Run: Pointer; var BitPos: byte): TFPColor;
-  var Channel, PaletteIndex: DWord;
+  var
+    Channel, PaletteIndex: DWord;
     GrayValue: Word;
+    lab: TLabA;
+    cmyk: TStdCMYK;
   begin
     for Channel := 0 to SampleCnt-1 do
       ReadImgValue(SampleBits[Channel], Run,BitPos,IFD.FillOrder,
                    IFD.Predictor,LastChannelValues[Channel],
                    ChannelValues[Channel]);
 
+    if IFD.PhotoMetricInterpretation >= 8 then
+    begin
+      GetPixelAsLab(lab);
+      result :=lab.ToExpandedPixel.ToFPColor; //MaxM: in Future we can use White Point an GammaCompression
+      exit;
+    end;
+
     case IFD.PhotoMetricInterpretation of
     0,1: // 0:bilevel grayscale 0 is white; 1:0 is black
       begin
@@ -1716,7 +1878,12 @@ var
     //4 Mask/holdout mask (obsolete by TIFF 6.0 specification)
 
     5: // CMYK plus optional alpha
-      result:=CMYKToFPColor(ChannelValues[0],ChannelValues[1],ChannelValues[2],ChannelValues[3]);
+      begin
+        //MaxM: Test the difference
+        //  result:=CMYKToFPColor(ChannelValues[0],ChannelValues[1],ChannelValues[2],ChannelValues[3]);
+        cmyk :=TStdCMYK.New(ChannelValues[0]/$ffff, ChannelValues[1]/$ffff, ChannelValues[2]/$ffff, ChannelValues[3]/$ffff);
+        result :=cmyk.ToExpandedPixel.ToFPColor(true); //MaxM: in Future we can use GammaCompression
+      end;
 
      //6: YCBCR: CCIR 601
      //8: CIELAB: 1976 CIE L*a*b*
@@ -1741,13 +1908,13 @@ var
   end;
 
 var
-  ChunkOffsets: PDWord;
+  ChunkOffsets: Pointer;
   ChunkByteCounts: PDWord;
   Chunk: PByte;
   ChunkCount: DWord;
   ChunkIndex: Dword;
-  CurCount: DWord;
-  CurOffset: DWord;
+  CurCount: SizeUInt;
+  CurOffset: SizeUInt;
   CurByteCnt: PtrInt;
   Run: PByte;
   BitPos: Byte;
@@ -1861,8 +2028,12 @@ begin
 
     // read chunks
     for ChunkIndex:=0 to ChunkCount-1 do begin
-      CurOffset:=ChunkOffsets[ChunkIndex];
+      if FBigTiff
+      then CurOffset:=PSizeUInt(ChunkOffsets)[ChunkIndex]
+      else CurOffset:=PDWord(ChunkOffsets)[ChunkIndex];
+
       CurByteCnt:=ChunkByteCounts[ChunkIndex];
+
       //writeln('TFPReaderTiff.LoadImageFromStream CurOffset=',CurOffset,' CurByteCnt=',CurByteCnt);
       if CurByteCnt<=0 then continue;
       ReAllocMem(Chunk,CurByteCnt);
@@ -2051,7 +2222,7 @@ end;
 
 function TFPReaderTiff.InternalCheck(Str: TStream): boolean;
 var
-  IFDStart: DWord;
+  IFDStart: SizeUInt;
 begin
   try
     s:=Str;

+ 18 - 18
packages/fcl-image/src/fptiffcmn.pas

@@ -137,7 +137,7 @@ type
   public
     IFDStart: SizeUInt; // tiff position
     IFDNext: SizeUInt; // tiff position
-    Artist: AnsiString;
+    Artist: String;
     BitsPerSample: SizeUInt; // tiff position of entry
     BitsPerSampleArray: array of Word;
     CellLength: DWord;
@@ -145,30 +145,30 @@ type
     ColorMap: SizeUInt;// tiff position of entry
     Compression: DWord;
     Predictor: Word;
-    Copyright: AnsiString;
-    DateAndTime: AnsiString;
-    DocumentName: AnsiString;
+    Copyright: string;
+    DateAndTime: string;
+    DocumentName: string;
     ExtraSamples: SizeUInt;// tiff position of entry
     FillOrder: DWord;
-    HostComputer: AnsiString;
-    ImageDescription: AnsiString;
+    HostComputer: string;
+    ImageDescription: string;
     ImageHeight: DWord;
     ImageIsMask: Boolean;
     ImageIsPage: Boolean;
     ImageIsThumbNail: Boolean;
     ImageWidth: DWord;
-    Make_ScannerManufacturer: AnsiString;
-    Model_Scanner: AnsiString;
+    Make_ScannerManufacturer: string;
+    Model_Scanner: string;
     Orientation: DWord;
     PageNumber: word; // the page number starting at 0, the total number of pages is PageCount
     PageCount: word; // see PageNumber
-    PageName: AnsiString;
+    PageName: string;
     PhotoMetricInterpretation: DWord;
     PlanarConfiguration: DWord;
     ResolutionUnit: DWord;
     RowsPerStrip: DWord;
     SamplesPerPixel: DWord;
-    Software: AnsiString;
+    Software: string;
     StripByteCounts: SizeUInt;// tiff position of entry
     StripOffsets: SizeUInt; // tiff position of entry
     TileWidth: DWord;
@@ -195,24 +195,24 @@ type
     destructor Destroy; override;
   end;
 
-function TiffRationalToStr(const r: TTiffRational): AnsiString;
-function StrToTiffRationalDef(const s: AnsiString; const Def: TTiffRational): TTiffRational;
+function TiffRationalToStr(const r: TTiffRational): string;
+function StrToTiffRationalDef(const s: string; const Def: TTiffRational): TTiffRational;
 procedure ClearTiffExtras(Img: TFPCustomImage);
 procedure CopyTiffExtras(SrcImg, DestImg: TFPCustomImage);
-procedure WriteTiffExtras(Msg: AnsiString; Img: TFPCustomImage);
-function TiffCompressionName(c: Word): AnsiString;
+procedure WriteTiffExtras(Msg: string; Img: TFPCustomImage);
+function TiffCompressionName(c: Word): string;
 
 function TifResolutionUnitToResolutionUnit(ATifResolutionUnit: DWord): TResolutionUnit;
 function ResolutionUnitToTifResolutionUnit(AResolutionUnit: TResolutionUnit): DWord;
 
 implementation
 
-function TiffRationalToStr(const r: TTiffRational): AnsiString;
+function TiffRationalToStr(const r: TTiffRational): string;
 begin
   Result:=IntToStr(r.Numerator)+'/'+IntToStr(r.Denominator);
 end;
 
-function StrToTiffRationalDef(const s: AnsiString; const Def: TTiffRational
+function StrToTiffRationalDef(const s: string; const Def: TTiffRational
   ): TTiffRational;
 var
   p: LongInt;
@@ -243,7 +243,7 @@ begin
       DestImg.Extra[SrcImg.ExtraKey[i]]:=SrcImg.ExtraValue[i];
 end;
 
-procedure WriteTiffExtras(Msg: AnsiString; Img: TFPCustomImage);
+procedure WriteTiffExtras(Msg: string; Img: TFPCustomImage);
 var
   i: Integer;
 begin
@@ -253,7 +253,7 @@ begin
       writeln('  ',i,' ',Img.ExtraKey[i],'=',Img.ExtraValue[i]);
 end;
 
-function TiffCompressionName(c: Word): AnsiString;
+function TiffCompressionName(c: Word): string;
 begin
   case c of
   1: Result:='no compression';