Вы когда-нибудь проверяли как будет выглядеть написанная вами с такой любовью программа с системе с крупными шрифтами? Согласитесь, это неприглядное зрелище. Наползающие друг на друга метки и поля редактирования, надписи, которые заканчиваются где то за пределами формы и т.п. После этого появляется неконтролируемая неприязнь к пользователям, которые предпочитают режим крупных шрифтов. Но это их право. И ваша проблема.
Вы наверняка задавались вопросом о том, как избежать искажений. И находили в сети одни и те же рецепты: использовать шрифты TrueType и отключать свойство Scaled у форм. Рецепт, предлагающий использовать только шрифты TrueType + Scaled = False для форм - верен. Однако тут есть некоторые неудобства.
Дело в том, что ни один из стандартных TrueType шрифтов не сравнится по качеству отображения с MS Sans Serif, который по умолчанию используется в вашем приложении. Самый близкий - Arial все же имеет довольно заметные отличия и проигрывает MS Sans Serif по читаемости.
Искажений форм так же полностью избежать не удастся. Особенно это может повлиять на компоновку сложных форм, а также при использовании в интерфейсе изображений и прочих немасштабируемых элементов. Иногда хочется просто запретить масштабирование и защитить программу от влияния крупных шрифтов. Но использовать MS Sans Serif в этом случае нельзя, так как в режиме крупных шрифтов система "сдвигает" их на 2 пункта вверх и шрифт 8pt MS Sans Serif выглядит как 10pt MS Sans Serif при мелких шрифтах.
Для справки: В режиме стандартных размеров шрифтов в качестве системного используется, в основном, MS Sans Serif - рубленый шрифт без засечек. Он имеет размеры 8pt, 10pt, 12pt, 14pt, 18pt и 24pt. В основном используется размер 8pt. В режиме крупных шрифтов система увеличивает все шрифты на 120%. ( С 96 pixels per inch до 120 pixels per inch). Шрифт MS Sans Serif имеет всего 6 размеров. Поэтому 8pt становится 10pt, 10pt - 12pt и т.д. Шрифт 8pt MS Sans Serif выглядит как 10pt MS Sans Serif при мелких шрифтах. Шрифты же TrueType могут имеют произвольные размеры и шаг изменения равен 1pt. Поэтому при крупных шрифтах размеры TrueType и не-TrueType шрифтов изменяются по разному.
Предлагаемое решение способно защитить программу от влияния режима крупных шрифтов и не отказываться от шрифта MS Sans Serif при разработке программы. Подход состоит в том, чтобы заменять все шрифты MS Sans Serif на Arial при запуске программы при крупных шрифтах. Создавать программу, естественно, следует при мелких шрифтах.
Можно написать невизуальный компонент и добавить его на каждую форму. Компонент при загрузке проверяет режим и при обнаружении режима "Big Fonts" "обходит" все визуальные компоненты для замены шрифта. Также компонент заботится о том, чтобы свойство Scaled у форм было отключено.
unit glSmallFontsDefence;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TglSmallFontsDefence = class(TComponent)
private
procedure UpdateFonts(Control: TWinControl);
{ Private declarations }
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;
procedure Register;
implementation
function IsSmallFonts: boolean;{Значение функции TRUE если мелкий шрифт}
var DC: HDC;
begin
DC:=GetDC(0);
Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);
{ В случае крупного шрифта будет 120}
ReleaseDC(0, DC);
end;
procedure Register;
begin
RegisterComponents('Gl Components', [TglSmallFontsDefence]);
end;
{ TglSmallFontsDefence }
constructor TglSmallFontsDefence.Create(AOwner: TComponent);
begin
inherited;
if (Owner is TForm) then (Owner as TForm).Scaled := false;
end;
procedure TglSmallFontsDefence.Loaded;
begin
inherited;
if (Owner is TForm) then (Owner as TForm).Scaled := false;
if csDesigning in ComponentState then
begin
if not IsSmallFonts then
ShowMessage('Проектирование приложения в режиме крупных' +
' шрифтов недопустимо!'#13#10+
'Компонент TglSmallFontsDefence отказывается' +
' работать в таких условиях.');
end else
UpdateFonts((Owner as TForm));
end;
procedure TglSmallFontsDefence.UpdateFonts(Control: TWinControl);
var
i: integer;
procedure UpdateFont(Font: TFont);
begin
if CompareText(Font.Name, 'MS Sans Serif') <> 0 then exit;
Font.Name := 'Arial';
end;
begin
if IsSmallFonts then exit;
UpdateFont(TShowFont(Control).Font);
with Control do
for i:=0 to ControlCount-1 do
begin
UpdateFont(TShowFont(Controls[i]).Font);
if Controls[i] is TWinControl then UpdateFonts(Controls[i] as TWinControl);
end;
end;
end.
Вы можете добавить свойство Options типа перечисления, в котором задать опции исключения некоторых классов компонентов. К примеру, можно добавить возможность отключать замену шрифтов для потомков TCustomGrid. Очень часто пользователи используют режим крупных шрифтов, чтобы улучшить читаемость таблиц данных (TDBGrid). Тогда не надо лишать их этой возможности.
Автор: Андрей Чудин