mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 12:59:24 +02:00
fcl-image: added BigTif and LabA color support
(cherry picked from commit 8c2bb60cc8dfd39fa6aeeece491c424780e79fe4)
This commit is contained in:
Massimo Magnano
Michaël Van Canneyt
parent
52e9657fd5
commit
d24b89fbd3
@ -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;
|
||||
|
||||
@ -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';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user