Für
VCL und FMX gibt es ja zentrale stelleb, wo sowas vorgegeben wird.
Da kann man sich beim Start reinhängen
oder später nochmal (bevor die jeweilige Form/Komponente geladen wurde).
Delphi-Quellcode:
//unit Vcl.Graphics;
var
// New TFont instances are intialized with the values in this structure:
DefFontData: TFontData = (
Handle: 0;
Height: 0;
Orientation: 0;
{ No rotation }
Pitch: fpDefault;
Style: [];
Charset : DEFAULT_CHARSET;
Name: '
Segoe UI');
procedure InitDefFontData;
const
sFontSubstitutes = '
SOFTWARE\Microsoft\Windows NT\CurrentVersion\FontSubstitutes';
{ do not localize }
var
Reg: TRegistry;
Name:
string;
begin
if TOSVersion.Check(6)
then
begin
DefFontData.Height := -MulDiv(9, ScreenLogPixels, 72);
DefFontData.
Name := '
Segoe UI';
Exit;
end;
DefFontData.Height := -MulDiv(8, ScreenLogPixels, 72);
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS)
and (GetDefFontCharset = SHIFTJIS_CHARSET)
then
Name := '
Tahoma';
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly(sFontSubstitutes)
then { do not localize }
begin
Name := Reg.ReadString('
MS Shell Dlg 2');
{ do not localize }
Reg.CloseKey;
end;
finally
Reg.Free;
end;
if Name <> '
'
then
DefFontData.
Name := UTF8EncodeToShortString(
Name);
end;
Delphi-Quellcode:
//unit FMX.Platform.Metrics.Win;
function TWinMetricsServices.GetDefaultFontFamilyName:
string;
var
NonClientMetrics: TNonClientMetrics;
begin
if FDefaultFontFamilyName.IsEmpty
then
begin
NonClientMetrics.cbSize := SizeOf(TNonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @NonClientMetrics, 0)
then
FDefaultFontFamilyName := NonClientMetrics.lfMessageFont.lfFaceName
else if TOSVersion.Check(6)
then
FDefaultFontFamilyName := '
Segoe UI'
else
FDefaultFontFamilyName := '
Tahoma';
end;
Result := FDefaultFontFamilyName;
end;
function TWinMetricsServices.GetDefaultFontSize: Single;
begin
Result := DefaultFontSize;
end;