Я тут нашел библиотеку одну, которая вроде все классно делает, только вот хочу сделать так, чтобы Images и Labels не масштабировать у которых Size <> 0. Кто бы подсказал как это сделать?
То есть все Image не масштабировать и
Label.Font.Size <> 0 не масштабировать.
- Код: Выделить всё
unit uscaledpi;
{$mode objfpc}{$H+}
interface
uses
Forms, Graphics, Controls;
procedure HighDPI(FromDPI: Integer);
procedure ScaleDPI(Control: TControl; FromDPI: Integer);
implementation
procedure HighDPI(FromDPI: Integer);
var
i: Integer;
begin
for i:=0 to Screen.FormCount-1 do
ScaleDPI(Screen.Forms[i],FromDPI);
end;
procedure ScaleDPI(Control: TControl; FromDPI: Integer);
var
n: Integer;
WinControl: TWinControl;
begin
if Screen.PixelsPerInch = FromDPI then exit;
with Control do begin
Left:=ScaleX(Left,FromDPI);
Top:=ScaleY(Top,FromDPI);
Width:=ScaleX(Width,FromDPI);
Height:=ScaleY(Height,FromDPI);
Font.Height := ScaleY(Font.GetTextHeight('Hg'),FromDPI);
end;
if Control is TWinControl then begin
WinControl:=TWinControl(Control);
if WinControl.ControlCount > 0 then begin
for n:=0 to WinControl.ControlCount-1 do begin
if WinControl.Controls[n] is TControl then begin
ScaleDPI(WinControl.Controls[n],FromDPI);
end;
end;
end;
end;
end;
end.