结果：
1.需要修改DELPHI自身的FMX.FontGlyphs.Android.pas，复制到程序的根目录下(红色部分为修改过的)。
2.字体文件从 C:WindowsFonts 直接拷贝到APP程序根目录后改名增加到Deployment即可，要什么字体，就拷贝什么字体。
3.注意字体文件的大小写。
修改后的FMX.FontGlyphs.Android.pas
1 {*******************************************************} 2 { } 3 { Delphi FireMonkey Platform } 4 {Copyright(c) 2013-2015 Embarcadero Technologies, Inc.} 5 { } 6 {*******************************************************} 7 8 unit FMX.FontGlyphs.Android; 9 10 interface 11 12 {$SCOPEDENUMS ON} 13 14 uses 15 FMX.FontGlyphs, Androidapi.JNI.GraphicsContentViewText; 16 17 type 18 TAndroidFontGlyphManager = class(TFontGlyphManager) 19 private 20 FPaint: JPaint; 21 //Current metrics 22 FTop: Integer; 23 FAscent: Integer; 24 FDescent: Integer; 25 FBottom: Integer; 26 FLeading: Integer; 27 protected 28 procedure LoadResource; override; 29 procedure FreeResource; override; 30 function DoGetGlyph(const Char: UCS4Char; const Settings: TFontGlyphSettings): TFontGlyph; override; 31 function DoGetBaseline: Single; override; 32 public 33 constructor Create; 34 destructor Destroy; override; 35 end; 36 37 implementation 38 39 uses 40 System.Types, System.Math, System.Character, System.Generics.Collections, System.UIConsts, System.UITypes, 41 System.Classes, System.SysUtils, FMX.Types, FMX.Surfaces, FMX.Graphics, Androidapi.JNI.JavaTypes, Androidapi.Bitmap, 42 Androidapi.JNIBridge, Androidapi.Helpers, 43 System.IOUtils;//引入System.IOUtils是为了能够获取Android的各种系统目录 44 45 { TAndroidFontGlyphManager } 46 47 constructor TAndroidFontGlyphManager.Create; 48 begin 49 inherited Create; 50 FPaint := TJPaint.Create; 51 end; 52 53 destructor TAndroidFontGlyphManager.Destroy; 54 begin 55 FPaint := nil; 56 inherited; 57 end; 58 59 procedure TAndroidFontGlyphManager.LoadResource; 60 const 61 BoldAndItalic = [TFontStyle.fsBold, TFontStyle.fsItalic]; 62 var 63 TypefaceFlag: Integer; 64 Typeface: JTypeface; 65 FamilyName: JString; 66 Metrics: JPaint_FontMetricsInt; 67 sFontFile: string;//修改加入的 68 begin 69 FPaint.setAntiAlias(True); 70 FPaint.setTextSize(CurrentSettings.Size * CurrentSettings.Scale); 71 FPaint.setARGB(255, 255, 255, 255); 72 if TOSVersion.Check(4, 0) then 73 FPaint.setHinting(TJPaint.JavaClass.HINTING_ON); 74 //Font 75 try 76 FamilyName := StringToJString(CurrentSettings.Family); 77 if (BoldAndItalic * CurrentSettings.Style) = BoldAndItalic then 78 TypefaceFlag := TJTypeface.JavaClass.BOLD_ITALIC 79 else 80 if TFontStyle.fsBold in CurrentSettings.Style then 81 TypefaceFlag := TJTypeface.JavaClass.BOLD 82 else 83 if TFontStyle.fsItalic in CurrentSettings.Style then 84 TypefaceFlag := TJTypeface.JavaClass.ITALIC 85 else 86 TypefaceFlag := TJTypeface.JavaClass.NORMAL; 87 { Fix Begin 修改开始.如果在下载目录中存在跟字体同名的.ttf 文件,那么优先使用 ttf 文件. 88 我是放在 SD 卡的下载目录中.大家可以按需要任意改这个位置. 89 甚至也可以放在 Asset 目录中,这样可以打包在 APK 中.} 90 sFontFile := TPath.GetSharedDownloadsPath + PathDelim + CurrentSettings.Family + '.TTF'; 91 if FileExists(sFontFile) then 92 Typeface := TJTypeface.JavaClass.createFromFile(StringToJString(sFontFile)) 93 else 94 begin 95 sFontFile := TPath.GetSharedDownloadsPath + PathDelim + CurrentSettings.Family + '.ttf'; 96 if FileExists(sFontFile) then 97 Typeface := TJTypeface.JavaClass.createFromFile(StringToJString(sFontFile)) 98 else 99 Typeface := TJTypeface.JavaClass.Create(FamilyName, TypefaceFlag); 100 end; 101 { Fix End 修改结束 } 102 FPaint.setTypeface(Typeface); 103 try 104 Metrics := FPaint.getFontMetricsInt; 105 // 106 FTop := Metrics.top; 107 FAscent := Metrics.ascent; 108 FDescent := Metrics.descent; 109 FBottom := Metrics.bottom; 110 FLeading := Metrics.leading; 111 finally 112 Metrics := nil; 113 end; 114 finally 115 FamilyName := nil; 116 Typeface := nil; 117 end; 118 end; 119 120 procedure TAndroidFontGlyphManager.FreeResource; 121 begin 122 if FPaint <> nil then 123 FPaint.reset; 124 end; 125 126 function TAndroidFontGlyphManager.DoGetBaseline: Single; 127 begin 128 Result := Abs(FAscent); 129 end; 130 131 function TAndroidFontGlyphManager.DoGetGlyph(const Char: UCS4Char; const Settings: TFontGlyphSettings): TFontGlyph; 132 var 133 Text: JString; 134 Bitmap: JBitmap; 135 Canvas: JCanvas; 136 GlyphRect: TRect; 137 C, I, J, Width, Height, OriginY: Integer; 138 Advance: Single; 139 Bounds: JRect; 140 GlyphStyle: TFontGlyphStyles; 141 PixelBuffer: Pointer; 142 Data: PIntegerArray; 143 Path: JPath; 144 PathMeasure: JPathMeasure; 145 PathLength: Single; 146 Coords: TJavaArray<Single>; 147 StartPoint, LastPoint, Point: TPointF; 148 NewContour, HasStartPoint: Boolean; 149 begin 150 Text := StringToJString(System.Char.ConvertFromUtf32(Char)); 151 try 152 Advance := FPaint.measureText(Text); 153 Height := Abs(FTop) + Abs(FBottom) + 2; 154 Width := Ceil(Abs(Advance)) + 2; 155 Bounds := TJRect.Create; 156 try 157 FPaint.getTextBounds(Text, 0, Text.length, Bounds); 158 if Bounds.left < 0 then 159 Width := Width - Bounds.left; 160 Bitmap := TJBitmap.JavaClass.createBitmap(Width, Height, TJBitmap_Config.JavaClass.ARGB_8888); 161 try 162 Canvas := TJCanvas.JavaClass.init(Bitmap); 163 try 164 if Bounds.left < 0 then 165 Canvas.drawText(Text, -Bounds.left, -FAscent, FPaint) 166 else 167 Canvas.drawText(Text, 0, -FAscent, FPaint); 168 finally 169 Canvas := nil; 170 end; 171 172 GlyphStyle := []; 173 if ((FAscent = 0) and (FDescent = 0)) or not HasGlyph(Char) then 174 GlyphStyle := [TFontGlyphStyle.NoGlyph]; 175 if TFontGlyphSetting.Path in Settings then 176 GlyphStyle := GlyphStyle + [TFontGlyphStyle.HasPath]; 177 178 // For some font sizes Ascent line is below Bounds.top, cuting off part of a glyph. 179 // Do not use Y-value of the origin point in such cases. 180 if FAscent > Bounds.top then 181 OriginY := 0 182 else 183 OriginY := Abs(FAscent - Bounds.top); 184 Result := TFontGlyph.Create(TPoint.Create(Bounds.left, OriginY), Advance, 185 Abs(FAscent) + Abs(FDescent) + Abs(FLeading), GlyphStyle); 186 187 if (TFontGlyphSetting.Bitmap in Settings) and (HasGlyph(Char) or ((FAscent <> 0) or (FDescent <> 0))) and 188 (AndroidBitmap_lockPixels(TJNIResolver.GetJNIEnv, (Bitmap as ILocalObject).GetObjectID, @PixelBuffer) = 0) then 189 begin 190 Data := PIntegerArray(PixelBuffer); 191 GlyphRect.Left := Bounds.left; 192 GlyphRect.Right := Bounds.Right; 193 GlyphRect.Top := OriginY; 194 GlyphRect.Bottom := Abs(FAscent - Bounds.bottom); 195 196 if (GlyphRect.Width > 0) or (GlyphRect.Height > 0) then 197 begin 198 Result.Bitmap.SetSize(GlyphRect.Width + 1, GlyphRect.Height + 1, TPixelFormat.BGRA); 199 if TFontGlyphSetting.PremultipliedAlpha in Settings then 200 begin 201 for I := GlyphRect.Top to GlyphRect.Bottom do 202 Move(Data[I * Width + Max(GlyphRect.Left, 0)], 203 Result.Bitmap.GetPixelAddr(0, I - GlyphRect.Top)^, Result.Bitmap.Pitch); 204 end 205 else 206 for I := GlyphRect.Top to GlyphRect.Bottom - 1 do 207 for J := GlyphRect.Left to GlyphRect.Right - 1 do 208 begin 209 C := Data[I * Width + J]; 210 if C <> 0 then 211 begin 212 C := ((C shr 16) and $FF + (C shr 8) and $FF + (C and $FF)) div 3; 213 Result.Bitmap.Pixels[J - GlyphRect.Left, I - GlyphRect.Top] := MakeColor($FF, $FF, $FF, C); 214 end 215 end; 216 end; 217 AndroidBitmap_unlockPixels(TJNIResolver.GetJNIEnv, (Bitmap as ILocalObject).GetObjectID); 218 end; 219 //Path 220 if TFontGlyphSetting.Path in Settings then 221 try 222 Path := TJPath.Create; 223 FPaint.getTextPath(Text, 0, Text.length, Result.Origin.X, Result.Origin.Y, Path); 224 PathMeasure := TJPathMeasure.Create; 225 PathMeasure.setPath(Path, False); 226 Coords := TJavaArray<Single>.Create(2); 227 if PathMeasure.getLength > 0 then 228 repeat 229 PathLength := PathMeasure.getLength; 230 NewContour := True; 231 HasStartPoint := False; 232 I := 0; 233 while I < PathLength do 234 begin 235 if PathMeasure.getPosTan(I, Coords, nil) then 236 begin 237 Point := PointF(Coords[0], Coords[1]); 238 if NewContour then 239 begin 240 Result.Path.MoveTo(Point); 241 NewContour := False; 242 HasStartPoint := False; 243 end 244 else 245 if Point <> LastPoint then 246 begin 247 if HasStartPoint and (LastPoint <> StartPoint) then 248 if not SameValue(((Point.Y - StartPoint.Y) / (Point.X - StartPoint.X)), ((Point.Y - LastPoint.Y) / (Point.X - LastPoint.X)), Epsilon) then 249 begin 250 Result.Path.LineTo(Point); 251 HasStartPoint := False; 252 end 253 else 254 else 255 Result.Path.LineTo(Point); 256 end; 257 LastPoint := Point; 258 if not HasStartPoint then 259 begin 260 StartPoint := Point; 261 HasStartPoint := True; 262 end; 263 end; 264 Inc(I); 265 end; 266 if Result.Path.Count > 0 then 267 Result.Path.ClosePath; 268 until not PathMeasure.nextContour; 269 Point := Result.Path.GetBounds.TopLeft; 270 Result.Path.Translate(-Point.X + Result.Origin.X, -Point.Y + Result.Origin.Y); 271 finally 272 FreeAndNil(Coords); 273 Path := nil; 274 PathMeasure := nil; 275 end; 276 finally 277 Bitmap.recycle; 278 Bitmap := nil; 279 end; 280 finally 281 Bounds := nil; 282 end; 283 finally 284 Text := nil; 285 end; 286 end; 287 288 end.
实例代码：
1 unit Unit1; 2 3 interface 4 5 uses 6 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 8 FMX.Controls.Presentation, FMX.StdCtrls; 9 10 type 11 TForm1 = class(TForm) 12 Label1: TLabel; 13 Button1: TButton; 14 Button2: TButton; 15 procedure FormCreate(Sender: TObject); 16 procedure Button1Click(Sender: TObject); 17 procedure Button2Click(Sender: TObject); 18 private 19 { Private declarations } 20 public 21 { Public declarations } 22 end; 23 24 var 25 Form1: TForm1; 26 27 implementation 28 uses System.IOUtils; 29 {$R *.fmx} 30 {$R *.NmXhdpiPh.fmx ANDROID} 31 32 procedure TForm1.Button1Click(Sender: TObject); 33 begin 34 Label1.Font.Family := 'STHUPO'; 35 end; 36 37 procedure TForm1.Button2Click(Sender: TObject); 38 begin 39 Label1.Font.Family := 'STLITI'; 40 end; 41 42 procedure TForm1.FormCreate(Sender: TObject); 43 var 44 fontfile, fontfilefrom: string; 45 begin 46 //文件名大小写敏感，切记 47 //这是我们能够引用的字体文件的目标位置： 48 fontfile := TPath.GetSharedDownloadsPath + PathDelim + 'STHUPO.TTF'; 49 //随程序安装后，字体文件位置，卸载程序时会被删除： 50 fontfilefrom := TPath.Combine(TPath.GetDocumentsPath, 'STHUPO.TTF'); 51 if FileExists(fontfilefrom) and (not FileExists(fontfile)) then 52 begin 53 tfile.Copy(fontfilefrom, fontfile); //将字体文件拷贝到我们设定的目录 54 end; 55 56 //文件名大小写敏感，切记 57 //这是我们能够引用的字体文件的目标位置： 58 fontfile := TPath.GetSharedDownloadsPath + PathDelim + 'STLITI.TTF'; 59 //随程序安装后，字体文件位置，卸载程序时会被删除： 60 fontfilefrom := TPath.Combine(TPath.GetDocumentsPath, 'STLITI.TTF'); 61 if FileExists(fontfilefrom) and (not FileExists(fontfile)) then 62 begin 63 tfile.Copy(fontfilefrom, fontfile); //将字体文件拷贝到我们设定的目录 64 end; 65 end; 66 67 end.