paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-15 11:39:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl, ide: highDPI: make designer DPI-aware

Browse Source 
git-svn-id: trunk@53584 -
This commit is contained in:
ondrej 2016-12-06 21:28:02 +00:00
parent 6b96ab0bc3
commit f1f10c72f9
5 changed files with 22 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ide/sourcefilemanager.pas
View File

@ -6168,6 +6168,9 @@ begin
Result:=LoadLFM(AnUnitInfo,LFMBuf,OpenFlags,CloseFlags);
end;
type
TAccessCustomDesignControl = class(TCustomDesignControl);
function TLazSourceFileManager.LoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer;
OpenFlags: TOpenFlags; CloseFlags: TCloseFlags): TModalResult;
const
@ -6197,6 +6200,7 @@ var
NewControl: TControl;
ARestoreVisible: Boolean;
AncestorClass: TComponentClass;
DsgControl: TCustomDesignControl;
begin
{$IFDEF IDE_DEBUG}
debugln('TLazSourceFileManager.LoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
@ -6375,6 +6379,16 @@ begin
NewControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster Delayed'){$ENDIF};
end;
if NewComponent is TCustomDesignControl then
begin
DsgControl := TCustomDesignControl(NewComponent);
if DsgControl.DesignTimePPI<>Screen.PixelsPerInch then
begin
DsgControl.AutoAdjustLayout(lapAutoAdjustForDPI, DsgControl.DesignTimePPI, Screen.PixelsPerInch, 0, 0, False);
TAccessCustomDesignControl(DsgControl).FDesignTimePPI := Screen.PixelsPerInch;
end;
end;
if NewComponent is TFrame then
AnUnitInfo.ResourceBaseClass:=pfcbcFrame
else if NewComponent is TDataModule then

6
lcl/forms.pp
View File

@ -258,7 +258,8 @@ type
procedure SetDesignTimePPI(const ADesignTimePPI: Integer);
protected
procedure Loaded; override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromDPI,
AToDPI, AOldFormWidth, ANewFormWidth: Integer; const AScaleFonts: Boolean); override;
public
constructor Create(TheOwner: TComponent); override;
public
@ -285,9 +286,6 @@ type
procedure DefineProperties(Filer: TFiler); override;
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromDPI,
AToDPI, AOldFormWidth, ANewFormWidth: Integer;
const AScaleFonts: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;

11
lcl/include/customdesigncontrol.inc
View File

@ -19,13 +19,14 @@ begin
FPixelsPerInch := FDesignTimePPI;
end;
procedure TCustomDesignControl.Loaded;
procedure TCustomDesignControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer;
const AScaleFonts: Boolean);
begin
inherited Loaded;
inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth,
ANewFormWidth, AScaleFonts);
if csDesigning in ComponentState then
FDesignTimePPI := Screen.PixelsPerInch;
FPixelsPerInch := FDesignTimePPI;
FPixelsPerInch := AToDPI;
end;
procedure TCustomDesignControl.SetDesignTimePPI(const ADesignTimePPI: Integer);

6
lcl/include/customform.inc
View File

@ -160,11 +160,8 @@ begin
inherited AfterConstruction;
if Scaled and (Screen.PixelsPerInch<>FPixelsPerInch) then
begin
AutoAdjustLayout(lapAutoAdjustForDPI, FPixelsPerInch, Screen.PixelsPerInch,
Width, MulDiv(Width, Screen.PixelsPerInch, FPixelsPerInch), False);
FPixelsPerInch := Screen.PixelsPerInch;
end;
end;
{------------------------------------------------------------------------------
@ -2245,11 +2242,8 @@ begin
begin
NewDpi := hi(Msg.wParam);
if Scaled and (NewDpi<>PixelsPerInch) then
begin
AutoAdjustLayout(lapAutoAdjustForDPI, FPixelsPerInch, NewDpi,
Width, MulDiv(Width, NewDpi, FPixelsPerInch), True);
FPixelsPerInch := NewDpi;
end;
end;
end;

10
lcl/include/customframe.inc
View File

@ -20,16 +20,6 @@ begin
ParentForm.DoAddActionList(ActionList);
end;
procedure TCustomFrame.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer;
const AScaleFonts: Boolean);
begin
inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth,
ANewFormWidth, AScaleFonts);
FPixelsPerInch := AToDPI;
end;
procedure TCustomFrame.RemoveActionList(ActionList: TCustomActionList);
var
ParentForm: TCustomForm;