Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #12 from Wormnest/JclFont_fix

Set correct system font on Windows 8 and higher in JclFont.pas.
  • Loading branch information...
commit d83e2aff37821598e7e46657ccf8590e0593238d 2 parents 8b9cd7b + 36512aa
@ahausladen ahausladen authored
Showing with 32 additions and 28 deletions.
  1. +32 −28 jcl/source/vcl/JclFont.pas
View
60 jcl/source/vcl/JclFont.pas
@@ -49,45 +49,47 @@ implementation
{$ENDIF ~HAS_UNITSCOPE}
JclSysUtils, JclSysInfo;
+// Save Windows version that way we will only determine it once here.
+// Might be even better if this variable was declared in JclSysInfo since
+// it is determined there anyway at startup.
+var
+ WindowsVersion: TWindowsVersion;
+
procedure SetCaptionFont(const AObjectFont: TFont);
begin
- if IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2 then
- begin
+ case WindowsVersion of
+ wvWin95..wvWinNT4:
+ begin
+ AObjectFont.Name := 'MS Sans Serif';
+ AObjectFont.Size := 8;
+ end;
+ wvWin2000..wvWin2003R2:
+ begin
+ AObjectFont.Name := 'Tahoma';
+ AObjectFont.Size := 8;
+ end;
+ else
AObjectFont.Name := 'Segoe UI';
AObjectFont.Size := 9;
- end
- else if IsWinXP or IsWin2k or IsWin2003 then
- begin
- // MS Shell Dlg 2
- AObjectFont.Name := 'Tahoma';
- AObjectFont.Size := 8;
- end
- else
- begin
- // MS Shell Dlg
- AObjectFont.Name := 'MS Sans Serif';
- AObjectFont.Size := 8;
end;
end;
procedure SetContentFont(const AObjectFont: TFont);
begin
- if IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2 then
- begin
+ case WindowsVersion of
+ wvWin95..wvWinNT4:
+ begin
+ AObjectFont.Name := 'MS Sans Serif';
+ AObjectFont.Size := 8;
+ end;
+ wvWin2000..wvWin2003R2:
+ begin
+ AObjectFont.Name := 'Verdana';
+ AObjectFont.Size := 8;
+ end;
+ else
AObjectFont.Name := 'Calibri';
AObjectFont.Size := 9;
- end
- else if IsWinXP or IsWin2k or IsWin2003 then
- begin
- // MS Shell Dlg 2
- AObjectFont.Name := 'Verdana';
- AObjectFont.Size := 8;
- end
- else
- begin
- // MS Shell Dlg
- AObjectFont.Name := 'MS Sans Serif';
- AObjectFont.Size := 8;
end;
end;
@@ -121,4 +123,6 @@ procedure SetObjectFontToSystemFont(const AObject: TObject; const FontType: TFon
end;
end;
+initialization
+ WindowsVersion := GetWindowsVersion;
end.
Please sign in to comment.
Something went wrong with that request. Please try again.