|
@@ -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;
|