Most Delphi applications are using MS Sans Serif 8 as their default font, meanwhile Windows XP system font is Tahoma 8.25 and Windows Vista system font is Segoe UI.
Below code makes Delphi applications use Windows system font:
procedure TForm1.FormCreate(Sender: TObject);
var
NonClientMetrics: TNonClientMetrics;
begin
NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);
Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
if Scaled then
begin
Font.Height := NonClientMetrics.lfMessageFont.lfHeight;
end;
end;
Comments
more accurate and working in
more accurate and working in Delphi 2010, version of above code is:
procedure GetSystemFont(Font: TFont); var LogFont: TLogFont; begin if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(TLogFont), @LogFont, 0) then begin Font.Height := LogFont.lfHeight; Font.Orientation := LogFont.lfOrientation; Font.Charset := TFontCharset(LogFont.lfCharSet); Font.Name := PChar(@LogFont.lfFaceName); Font.Style := []; if LogFont.lfWeight >= FW_BOLD then Font.Style := Font.Style + [fsBold]; if LogFont.lfItalic = 1 then Font.Style := Font.Style + [fsItalic]; if LogFont.lfUnderline = 1 then Font.Style := Font.Style + [fsUnderline]; if LogFont.lfStrikeOut = 1 then Font.Style := Font.Style + [fsStrikeOut]; case LogFont.lfPitchAndFamily and $F of VARIABLE_PITCH: Font.Pitch := fpVariable; FIXED_PITCH: Font.Pitch := fpFixed; else Font.Pitch := fpDefault; end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin GetSystemFont(Font); end;courtesy of http://stackoverflow.com/questions/401075/delphi-handling-users-font-preference/448574#448574
Post new comment