Browse Source

* Patch from Mattias for #11809

git-svn-id: trunk@11589 -
marco 17 years ago
parent
commit
cebfe55996

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

@@ -60,7 +60,7 @@ type
     public
     public
       constructor Create (ACount : integer);
       constructor Create (ACount : integer);
       destructor destroy; override;
       destructor destroy; override;
-      procedure GetBoundRect (var aRect : TRect);
+      procedure GetBoundRect (out aRect : TRect);
       property Text : string read FText;
       property Text : string read FText;
       property Mode : TBitmapType read FMode;
       property Mode : TBitmapType read FMode;
       property Count : integer read GetCount;
       property Count : integer read GetCount;
@@ -105,7 +105,6 @@ type
       CurFont : TMgrFont;
       CurFont : TMgrFont;
       CurSize : PMgrSize;
       CurSize : PMgrSize;
       CurRenderMode : FT_Render_Mode;
       CurRenderMode : FT_Render_Mode;
-      CurTransform : FT_Matrix;
       UseKerning : boolean;
       UseKerning : boolean;
       function GetSearchPath : string;
       function GetSearchPath : string;
       procedure SetSearchPath (AValue : string);
       procedure SetSearchPath (AValue : string);
@@ -120,7 +119,7 @@ type
       procedure SetPixelSize (aSize, aResolution : integer);
       procedure SetPixelSize (aSize, aResolution : integer);
       function GetGlyph (c : char) : PMgrGlyph;
       function GetGlyph (c : char) : PMgrGlyph;
       function CreateGlyph (c : char) : PMgrGlyph;
       function CreateGlyph (c : char) : PMgrGlyph;
-      procedure MakeTransformation (angle:real; var Transformation:FT_Matrix);
+      procedure MakeTransformation (angle:real; out Transformation:FT_Matrix);
       procedure InitMakeString (FontID, Size:integer);
       procedure InitMakeString (FontID, Size:integer);
       function MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
       function MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
       function MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
       function MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
@@ -187,6 +186,47 @@ begin
     FTError(Msg,Result);
     FTError(Msg,Result);
 end;
 end;
 
 
+{procedure WriteFT_Face(CurFont: PFT_Face);
+var
+  i: Integer;
+begin
+  writeln(' num_faces=',CurFont^.num_faces);
+  writeln(' face_index=',CurFont^.face_index);
+  writeln(' face_flags=',CurFont^.face_flags);
+  writeln(' style_flags=',CurFont^.style_flags);
+  writeln(' num_glyphs=',CurFont^.num_glyphs);
+  writeln(' family_name=',CurFont^.family_name<>nil);
+  writeln(' style_name=',CurFont^.style_name<>nil);
+  {if CurFont^.style_name<>nil then begin
+    writeln('   ',CurFont^.style_name^);
+  end;}
+  writeln(' num_fixed_sizes=',CurFont^.num_fixed_sizes);
+  writeln(' available_sizes=',CurFont^.available_sizes<>nil);
+  for i:=1 to CurFont^.num_fixed_sizes do begin
+    writeln('   ',i,' ',CurFont^.available_sizes^[i-1].width,'x',CurFont^.available_sizes^[i-1].height);
+  end;
+  writeln(' num_charmaps=',CurFont^.num_charmaps);
+  writeln(' charmaps=',CurFont^.charmaps<>nil);
+  writeln(' generic.data=',CurFont^.generic.data<>nil);
+  writeln(' generic.finalizer=',CurFont^.generic.finalizer<>nil);
+  writeln(' bbox.xMin=',CurFont^.bbox.xMin,
+    ' bbox.xMax=',CurFont^.bbox.xMax,
+    ' bbox.yMin=',CurFont^.bbox.yMin,
+    ' bbox.yMax=',CurFont^.bbox.yMax,
+    ' units_per_EM=',CurFont^.units_per_EM,
+    ' ascender=',CurFont^.ascender,
+    ' descender=',CurFont^.descender,
+    ' height=',CurFont^.height,
+    ' max_advance_width=',CurFont^.max_advance_width,
+    ' max_advance_height=',CurFont^.max_advance_height,
+    ' underline_position=',CurFont^.underline_position,
+    ' underline_thickness=',CurFont^.underline_thickness,
+    ' glyph=',CurFont^.glyph<>nil,
+    ' size=',CurFont^.size<>nil,
+    ' charmap=',CurFont^.charmap<>nil,
+    '');
+end;}
+
 { TMgrFont }
 { TMgrFont }
 
 
 constructor TMgrFont.Create (aMgr:TFontManager; afilename:string; anindex:integer);
 constructor TMgrFont.Create (aMgr:TFontManager; afilename:string; anindex:integer);
@@ -199,6 +239,7 @@ begin
   LastSize := nil;
   LastSize := nil;
   Try
   Try
     FTCheck(FT_New_Face (aMgr.FTLib, pchar(afilename), anindex, font),format (sErrLoadFont,[anindex,afilename]));
     FTCheck(FT_New_Face (aMgr.FTLib, pchar(afilename), anindex, font),format (sErrLoadFont,[anindex,afilename]));
+    //WriteFT_Face(font);
   except
   except
     Font:=Nil;
     Font:=Nil;
     Raise;
     Raise;
@@ -461,7 +502,7 @@ begin
       end;
       end;
 end;
 end;
 
 
-procedure TFontManager.MakeTransformation (angle:real; var Transformation:FT_Matrix);
+procedure TFontManager.MakeTransformation (angle:real; out Transformation:FT_Matrix);
 begin
 begin
   with Transformation do
   with Transformation do
     begin
     begin
@@ -476,8 +517,10 @@ function TFontManager.CreateGlyph (c : char) : PMgrGlyph;
 var e : integer;
 var e : integer;
 begin
 begin
   new (result);
   new (result);
+  FillByte(Result^,SizeOf(Result),0);
   result^.character := c;
   result^.character := c;
   result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, ord(c));
   result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, ord(c));
+  //WriteFT_Face(CurFont.Font);
   e := FT_Load_Glyph (CurFont.font, result^.GlyphIndex, FT_Load_Default);
   e := FT_Load_Glyph (CurFont.font, result^.GlyphIndex, FT_Load_Default);
   if e <> 0 then
   if e <> 0 then
     begin
     begin
@@ -517,7 +560,7 @@ function TFontManager.MakeString (FontId:integer; Text:string; size:integer; ang
 var g : PMgrGlyph;
 var g : PMgrGlyph;
     bm : PFT_BitmapGlyph;
     bm : PFT_BitmapGlyph;
     gl : PFT_Glyph;
     gl : PFT_Glyph;
-    e, prevIndex, prevx, c, r, rx : integer;
+    prevIndex, prevx, c, r, rx : integer;
     pre, adv, pos, kern : FT_Vector;
     pre, adv, pos, kern : FT_Vector;
     buf : PByteArray;
     buf : PByteArray;
     reverse : boolean;
     reverse : boolean;
@@ -828,7 +871,7 @@ begin
       end;
       end;
 end;
 end;
 
 
-procedure TStringBitmaps.GetBoundRect (var aRect : TRect);
+procedure TStringBitmaps.GetBoundRect (out aRect : TRect);
 begin
 begin
   aRect := FBounds;
   aRect := FBounds;
 end;
 end;

+ 10 - 4
packages/fcl-image/src/freetypeh.pp

@@ -106,14 +106,20 @@ type
   FT_UShort = word;
   FT_UShort = word;
   FT_Int = longint;
   FT_Int = longint;
   FT_UInt = longword;
   FT_UInt = longword;
+  {$if defined(cpu64) and not(defined(win64) and defined(cpux86_64))}
+  FT_Long = int64;
+  FT_ULong = qword;
+  FT_Pos = int64;
+  {$ELSE}
   FT_Long = longint;
   FT_Long = longint;
   FT_ULong = longword;
   FT_ULong = longword;
+  FT_Pos = longint;
+  {$ENDIF}
   FT_F2Dot14 = smallint;
   FT_F2Dot14 = smallint;
   FT_F26Dot6 = longint;
   FT_F26Dot6 = longint;
   FT_Fixed = longint;
   FT_Fixed = longint;
   FT_Error = longint;
   FT_Error = longint;
   FT_Pointer = pointer;
   FT_Pointer = pointer;
-  FT_Pos = longint;
   //FT_Offset = size_t;
   //FT_Offset = size_t;
   //FT_PtrDist = size_t;
   //FT_PtrDist = size_t;
 
 
@@ -321,11 +327,11 @@ function FT_Set_Pixel_Sizes(face:PFT_Face; pixel_width,pixel_height:FT_UInt) : i
 function FT_Set_Char_Size(face:PFT_Face; char_width,char_height:FT_F26dot6;horz_res, vert_res:FT_UInt) : integer; cdecl; external freetypedll name 'FT_Set_Char_Size';
 function FT_Set_Char_Size(face:PFT_Face; char_width,char_height:FT_F26dot6;horz_res, vert_res:FT_UInt) : integer; cdecl; external freetypedll name 'FT_Set_Char_Size';
 function FT_Get_Char_Index(face:PFT_Face; charcode:FT_ULong):FT_UInt; cdecl; external freetypedll name 'FT_Get_Char_Index';
 function FT_Get_Char_Index(face:PFT_Face; charcode:FT_ULong):FT_UInt; cdecl; external freetypedll name 'FT_Get_Char_Index';
 function FT_Load_Glyph(face:PFT_Face; glyph_index:FT_UInt ;load_flags:longint):integer; cdecl; external freetypedll name 'FT_Load_Glyph';
 function FT_Load_Glyph(face:PFT_Face; glyph_index:FT_UInt ;load_flags:longint):integer; cdecl; external freetypedll name 'FT_Load_Glyph';
-function FT_Get_Kerning(face:PFT_Face; left_glyph, right_glyph, kern_mode:FT_UInt; var akerning:FT_Vector) : integer; cdecl; external freetypedll name 'FT_Get_Kerning';
+function FT_Get_Kerning(face:PFT_Face; left_glyph, right_glyph, kern_mode:FT_UInt; out akerning:FT_Vector) : integer; cdecl; external freetypedll name 'FT_Get_Kerning';
 
 
-function FT_Get_Glyph(slot:PFT_GlyphSlot; var aglyph:PFT_Glyph) : integer; cdecl; external freetypedll name 'FT_Get_Glyph';
+function FT_Get_Glyph(slot:PFT_GlyphSlot; out aglyph:PFT_Glyph) : integer; cdecl; external freetypedll name 'FT_Get_Glyph';
 function FT_Glyph_Transform(glyph:PFT_Glyph; matrix:PFT_Matrix; delta:PFT_Vector) : integer; cdecl; external freetypedll name 'FT_Glyph_Transform';
 function FT_Glyph_Transform(glyph:PFT_Glyph; matrix:PFT_Matrix; delta:PFT_Vector) : integer; cdecl; external freetypedll name 'FT_Glyph_Transform';
-function FT_Glyph_Copy(source:PFT_Glyph; var target:PFT_Glyph): integer; cdecl; external freetypedll name 'FT_Glyph_Copy';
+function FT_Glyph_Copy(source:PFT_Glyph; out target:PFT_Glyph): integer; cdecl; external freetypedll name 'FT_Glyph_Copy';
 procedure FT_Glyph_Get_CBox(glyph:PFT_Glyph;bbox_mode:FT_UInt;var acbox:FT_BBox); cdecl; external freetypedll name 'FT_Glyph_Get_CBox';
 procedure FT_Glyph_Get_CBox(glyph:PFT_Glyph;bbox_mode:FT_UInt;var acbox:FT_BBox); cdecl; external freetypedll name 'FT_Glyph_Get_CBox';
 function FT_Glyph_To_Bitmap(var the_glyph:PFT_Glyph;render_mode:FT_Render_Mode;origin:PFT_Vector; destroy:FT_Bool):integer; cdecl; external freetypedll name 'FT_Glyph_To_Bitmap';
 function FT_Glyph_To_Bitmap(var the_glyph:PFT_Glyph;render_mode:FT_Render_Mode;origin:PFT_Vector; destroy:FT_Bool):integer; cdecl; external freetypedll name 'FT_Glyph_To_Bitmap';
 procedure FT_Done_Glyph (glyph:PFT_Glyph); cdecl; external freetypedll name 'FT_Done_Glyph';
 procedure FT_Done_Glyph (glyph:PFT_Glyph); cdecl; external freetypedll name 'FT_Done_Glyph';

+ 1 - 2
packages/fcl-image/src/ftfont.pp

@@ -242,8 +242,7 @@ begin
 end;
 end;
 
 
 procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:string);
 procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:string);
-var r,i : integer;
-    f : longint;
+var r : integer;
 begin
 begin
   GetText (atext);
   GetText (atext);
   with FLastText do
   with FLastText do