paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 21:33:17 +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; fStream: TStream;
fPosition: DWord; fPosition: DWord;
procedure ClearEntries; procedure ClearEntries;
procedure SortEntries;
procedure WriteTiff; procedure WriteTiff;
procedure WriteHeader; procedure WriteHeader;
procedure WriteIFDs; procedure WriteIFDs;
@ -257,6 +258,29 @@ begin
WriteDWord(8); WriteDWord(8);
end; 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; procedure TFPWriterTiff.WriteIFDs;
var var
i: Integer; i: Integer;
@ -265,6 +289,8 @@ var
Entry: TTiffWriterEntry; Entry: TTiffWriterEntry;
NextIFDPos: DWord; NextIFDPos: DWord;
begin begin
// Sort the Entries before writing!
SortEntries;
for i:=0 to FEntries.Count-1 do begin for i:=0 to FEntries.Count-1 do begin
List:=TFPList(FEntries[i]); List:=TFPList(FEntries[i]);
// write count // write count
@ -553,7 +579,8 @@ begin
TilesDown:=(OrientedHeight+IFD.TileLength{%H-}-1) div IFD.TileLength; TilesDown:=(OrientedHeight+IFD.TileLength{%H-}-1) div IFD.TileLength;
ChunkCount:=TilesAcross*TilesDown; ChunkCount:=TilesAcross*TilesDown;
{$IFDEF FPC_Debug_Image} {$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} {$ENDIF}
end else begin end else begin
ChunkCount:=(OrientedHeight+IFD.RowsPerStrip{%H-}-1) div IFD.RowsPerStrip; ChunkCount:=(OrientedHeight+IFD.RowsPerStrip{%H-}-1) div IFD.RowsPerStrip;