Browse Source

* Merging revisions r42143,r42144 from trunk:
------------------------------------------------------------------------
r42143 | marco | 2019-05-31 11:38:45 +0200 (Fri, 31 May 2019) | 2 lines

* mantis #35586

------------------------------------------------------------------------
r42144 | marco | 2019-05-31 11:41:28 +0200 (Fri, 31 May 2019) | 2 lines

* freetype windows compat patch from Pascal Riekenberg, mantis #35644

------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@42428 -

michael 6 years ago
parent
commit
0dfec0d081

+ 28 - 1
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;

+ 4 - 6
packages/fcl-image/src/freetype.pp

@@ -31,7 +31,7 @@ uses sysutils, classes, {$IFDEF DYNAMIC}freetypehdyn{$ELSE}freetypeh{$ENDIF}, FP
               fontfiles and faces available in a fontfile }
 
 // determine if file comparison need to be case sensitive or not
-{$ifdef WIN32}
+{$ifdef windows}
   {$undef CaseSense}
 {$else}
   {$define CaseSense}
@@ -200,8 +200,6 @@ const
 
 implementation
 
-{$IFDEF win32}uses dos;{$ENDIF}
-
 procedure FTError (Event:string; Err:integer);
 begin
   raise FreeTypeException.CreateFmt (sErrFreeType, [Err,Event]);
@@ -1032,15 +1030,15 @@ begin
   aRect := FBounds;
 end;
 
-{$ifdef win32}
+{$ifdef WINDOWS}
 procedure SetWindowsFontPath;
 begin
-  DefaultSearchPath := includetrailingbackslash(GetEnv('windir')) + 'fonts';
+  DefaultSearchPath := includetrailingbackslash(GetEnvironmentVariable('windir')) + 'fonts';
 end;
 {$endif}
 
 initialization
-  {$ifdef win32}
+  {$ifdef WINDOWS}
   SetWindowsFontPath;
   {$endif}
 end.

+ 1 - 1
packages/fcl-image/src/libfreetype.inc

@@ -6,7 +6,7 @@ Const
 
 // Windows
 {$ifdef windows}
-  FreeTypeDLL = 'freetype-6.dll';   // version 2.1.4
+  FreeTypeDLL = 'freetype.dll';
   {$define ft_found_platform}
 {$endif}