diff --git a/packages/fcl-image/src/fpwritetiff.pas b/packages/fcl-image/src/fpwritetiff.pas index abf756b59b..fa6d40c34c 100644 --- a/packages/fcl-image/src/fpwritetiff.pas +++ b/packages/fcl-image/src/fpwritetiff.pas @@ -82,6 +82,7 @@ type fStream: TStream; fPosition: DWord; procedure ClearEntries; + procedure SortEntries; procedure WriteTiff; procedure WriteHeader; procedure WriteIFDs; @@ -257,6 +258,29 @@ begin WriteDWord(8); end; +procedure TFPWriterTiff.SortEntries; +var + i, j: Integer; + Entry: TTiffWriterEntry; + List: TFPList; +begin + // Sort Entries by Tag Value Ascending + for i:= 0 to FEntries.Count-1 do begin + List := TFPList(FEntries[i]); + j := 0; + repeat + if TTiffWriterEntry(List[j]).Tag > TTiffWriterEntry(List[j+1]).Tag then begin + Entry := TTiffWriterEntry(List[j+1]); + List[j] := List[j+1]; + List[j+1] := Entry; + j := 0; + end + else + j := j+1; + until j >= List.Count-2; + end; +end; + procedure TFPWriterTiff.WriteIFDs; var i: Integer; @@ -265,6 +289,8 @@ var Entry: TTiffWriterEntry; NextIFDPos: DWord; begin + // Sort the Entries before writing! + SortEntries; for i:=0 to FEntries.Count-1 do begin List:=TFPList(FEntries[i]); // write count @@ -553,7 +579,8 @@ begin TilesDown:=(OrientedHeight+IFD.TileLength{%H-}-1) div IFD.TileLength; ChunkCount:=TilesAcross*TilesDown; {$IFDEF FPC_Debug_Image} - writeln('TFPWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' OrientedHeight=',OrientedHeight,' TileWidth=',IFD.TileWidth,' TileLength=',IFD.TileLength,' TilesAcross=',TilesAcross,' TilesDown=',TilesDown,' ChunkCount=',ChunkCount); + writeln('TFPWriterTiff.AddImage BitsPerPixel=',BitsPerPixel,' OrientedWidth=',OrientedWidth,' OrientedHeight=',OrientedHeight,' TileWidth=',IFD.TileWidth,' TileLength=',IFD.TileLength,' TilesAcross=',TilesAcross,' TilesDown=',TilesDown,' ChunkCoun +t=',ChunkCount); {$ENDIF} end else begin ChunkCount:=(OrientedHeight+IFD.RowsPerStrip{%H-}-1) div IFD.RowsPerStrip;