paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* mantis #35586

Browse Source 
git-svn-id: trunk@42143 -
This commit is contained in:
marco 2019-05-31 09:38:45 +00:00
parent 553da0e126
commit 6d65a8f1e3
1 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
packages/fcl-image/src/fpwritetiff.pas
View File

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