Защита приложений от крупных шрифтов

Code:

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.