paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 17:55:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Support Arial and Helvetica font families better on all platforms. Issue #28165, patch from Johann.

Browse Source 
git-svn-id: trunk@49158 -
This commit is contained in:
juha 2015-05-24 22:05:14 +00:00
parent 82f35aa13d
commit db9994a7e8
1 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/lazutils/lazfreetypefontcollection.pas
View File

@ -124,6 +124,12 @@ procedure SetDefaultFreeTypeFontCollection(ACollection : TCustomFreeTypeFontColl
implementation
const
//one of these files will be used as a default font
ArialLikeFonts: array[0..8] of string = ('Helvetica', 'Helvetica Neue',
'Arial', 'Nimbus Sans L', 'Microsoft Sans Serif', 'FreeSans',
'Liberation Sans', 'DejaVu Sans Condensed', 'Tahoma');
type
{ TFamilyEnumerator }
@ -759,6 +765,8 @@ end;
function TFreeTypeFontCollection.GetFamily(AName: string
): TCustomFamilyCollectionItem;
var
i,j: Integer;
begin
if AName = '' then
begin
@ -766,14 +774,43 @@ begin
exit;
end;
result := FindFamily(AName);
if (result = nil) and (CompareText(AName,'Arial')=0) then result := FindFamily('Helvetica');
if (result = nil) and (CompareText(AName,'Helvetica')=0) then result := FindFamily('Arial');
if result <> nil then exit;
if (CompareText(AName,'Arial')=0) then
begin
if result = nil then result := FindFamily('Helvetica Neue');
if result = nil then result := FindFamily('Helvetica');
end else
if (CompareText(AName,'Helvetica')=0) then
begin
if result = nil then result := FindFamily('Helvetica Neue');
if result = nil then result := FindFamily('Arial');
end else
if (CompareText(AName,'Helvetica Neue')=0) then
begin
if result = nil then result := FindFamily('Helvetica');
if result = nil then result := FindFamily('Arial');
end;
if result <> nil then exit;
for i := low(ArialLikeFonts) to high(ArialLikeFonts) do
if CompareText(AName,ArialLikeFonts[i])=0 then
begin
for j := 0 to high(ArialLikeFonts) do
begin
result := FindFamily(ArialLikeFonts[j]);
if result <> nil then break;
end;
break;
end;
if (result = nil) and (CompareText(AName,'Courier New')=0) then result := FindFamily('Nimbus Monospace');
if (result = nil) and (CompareText(AName,'Courier New')=0) then result := FindFamily('Courier');
if (result = nil) and (CompareText(AName,'Nimbus Monospace')=0) then result := FindFamily('Courier New');
if (result = nil) and (CompareText(AName,'Nimbus Monospace')=0) then result := FindFamily('Courier');
if (result = nil) and (CompareText(AName,'Courier')=0) then result := FindFamily('Courier New');
if (result = nil) and (CompareText(AName,'Courier')=0) then result := FindFamily('Nimbus Monospace');
if (result = nil) and (CompareText(AName,'Times')=0) then result := FindFamily('Times New Roman');
if (result = nil) and (CompareText(AName,'Times')=0) then result := FindFamily('CG Times');
if (result = nil) and (CompareText(AName,'Times New Roman')=0) then result := FindFamily('Times');