67 lines
1.5 KiB
ObjectPascal
67 lines
1.5 KiB
ObjectPascal
|
unit uDisplayUtils;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
|
|
uGUIBase, uCustomEditor;
|
||
|
|
|
||
|
|
procedure ScaleFormFont(AForm : TForm);
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
TypInfo;
|
||
|
|
|
||
|
|
procedure SetFontProperties(Control: TControl; Name: TFontName; Size: Integer; Styles: TFontStyles);
|
||
|
|
// Set font properties
|
||
|
|
var
|
||
|
|
Index: Integer;
|
||
|
|
Font: TFont;
|
||
|
|
AnObject: TObject;
|
||
|
|
ChildControl: TControl;
|
||
|
|
begin
|
||
|
|
// Set font properties
|
||
|
|
try
|
||
|
|
AnObject := GetObjectProp(Control, 'Font', nil);
|
||
|
|
if AnObject is TFont then
|
||
|
|
begin
|
||
|
|
// Set properties
|
||
|
|
Font := TFont(AnObject);
|
||
|
|
Font.Name := Name;
|
||
|
|
Font.Size := Size;
|
||
|
|
Font.Style := Styles;
|
||
|
|
end;
|
||
|
|
except
|
||
|
|
// ignorar las excepciones EPropertyError por no encontrar la propiedad
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Set child font properties
|
||
|
|
if Control is TWinControl then
|
||
|
|
begin
|
||
|
|
// Set
|
||
|
|
for Index := 0 to TWinControl(Control).ControlCount - 1 do
|
||
|
|
begin
|
||
|
|
// Child control
|
||
|
|
ChildControl := TWinControl(Control).Controls[Index];
|
||
|
|
|
||
|
|
// Set font properties
|
||
|
|
try
|
||
|
|
SetFontProperties(ChildControl, Name, Size, Styles);
|
||
|
|
except
|
||
|
|
// ignorar las excepciones EPropertyError por no encontrar la propiedad
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ScaleFormFont(AForm : TForm);
|
||
|
|
begin
|
||
|
|
AForm.ScaleBy(Screen.PixelsPerInch, 96);
|
||
|
|
SetFontProperties(AForm, Screen.IconFont.Name, Screen.IconFont.Size, Screen.IconFont.Style);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|