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

Merged revision(s) 56909-56910 #44d4157a28-#44d4157a28, 56946-56947 #8726ea2759-#8726ea2759, 56962 #d7f8f5e5f6, 57082 #81c4a099c2, 57156 #a0ccf85be3 from trunk:

Browse Source 
LCL: TListView: fix setting column width. Issue #32920
........
LCL: TListView: store column widths on handle destruction. Issue #32922
........
LCL: revert r50942 #dfebe2190c. Issue #28654
........
LCL: fix autosizing for not-aligned controls. Issue #28654
........
LCL: High-DPI: fix font scaling and design-time scaling. Issues #32882 and #32944
........
LCL: fix regression in autosize after r56947 #9ecac75432. Issue #28654
........
LCL: form: scale form with parent. Issue #33002
........

git-svn-id: branches/fixes_1_8@57258 -
This commit is contained in:
maxim 2018-02-05 22:18:24 +00:00
parent 1fd0fb7e36
commit 5e483185ba
11 changed files with 152 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ide/customformeditor.pp
View File

@ -1200,7 +1200,7 @@ const
PreferredDistanceMax = 250;
var
NewJITIndex: Integer;
CompLeft, CompTop, CompWidth, CompHeight: integer;
CompLeft, CompTop, CompWidth, CompHeight, NewPPI: integer;
NewComponent: TComponent;
OwnerComponent: TComponent;
JITList: TJITComponentList;
@ -1370,6 +1370,16 @@ begin
if CompTop < 0 then
CompTop := 0;
if AParent<>nil then
NewPPI := NeedParentDesignControl(AParent).PixelsPerInch
else
if (AControl is TCustomForm) then
NewPPI := TCustomForm(AControl).Monitor.PixelsPerInch
else
NewPPI := 0;
if NewPPI > 0 then
AControl.AutoAdjustLayout(lapAutoAdjustForDPI, 96, NewPPI, 0, 0);
if (AParent <> nil) or (AControl is TCustomForm) then
begin
// set parent after placing control to prevent display at (0,0)

1
lcl/comctrls.pp
View File

@ -1238,6 +1238,7 @@ type
function GetItem(const AIndex: Integer): TListColumn;
procedure WSCreateColumns;
procedure SetItem(const AIndex: Integer; const AValue: TListColumn);
procedure DoFinalizeWnd;
protected
function GetOwner: TPersistent; override;
public

5
lcl/controls.pp
View File

@ -1423,7 +1423,7 @@ type
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); virtual;
procedure DoFixDesignFontPPI(const AFont: TFont; const ADesignTimePPI: Integer);
procedure DoScaleFontPPI(const AFont: TFont; const AProportion: Double);
procedure DoScaleFontPPI(const AFont: TFont; const AToPPI: Integer; const AProportion: Double);
protected
// actions
function GetActionLinkClass: TControlActionLinkClass; virtual;
@ -1550,8 +1550,7 @@ type
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); virtual;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); virtual;
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
procedure ScaleFontsPPI(const AProportion: Double); virtual;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
public
constructor Create(TheOwner: TComponent);override;
destructor Destroy; override;

5
lcl/forms.pp
View File

@ -265,13 +265,14 @@ type
protected
procedure SetScaled(const AScaled: Boolean); virtual;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
procedure Loaded; override;
public
constructor Create(TheOwner: TComponent); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
public
property DesignTimeDPI: Integer read FDesignTimePPI write SetDesignTimePPI stored False; deprecated {$IFNDEF FPDOC}'Use DesignTimePPI instead. DesignTimeDPI will be removed in 1.8'{$ENDIF};
property DesignTimePPI: Integer read FDesignTimePPI write SetDesignTimePPI default 96;

193
lcl/include/control.inc
View File

@ -827,12 +827,13 @@ begin
Result := MulDiv(ASize, Screen.PixelsPerInch, Font.PixelsPerInch);
end;
procedure TControl.ScaleFontsPPI(const AProportion: Double);
procedure TControl.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin
// Problem: all fonts have to be scaled.
// Override this function - list all custom fonts in the overriden procedure
DoScaleFontPPI(Font, AProportion);
DoScaleFontPPI(Font, AToPPI, AProportion);
end;
{------------------------------------------------------------------------------
@ -935,18 +936,6 @@ procedure TControl.ExecuteDefaultAction;
begin
end;
procedure TControl.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
// Problem: Font.PixelsPerInch isn't saved in the LFM, therefore the
// design-time font PPI is different from the one that is loaded on target
// machine, which results in different font scaling.
// DoFixDesignFont restores the corrent design-time font PPI so that it can
// be used for LCL HighDPI scaling.
// Override this function - list all custom fonts in the overriden procedure
DoFixDesignFontPPI(Font, ADesignTimePPI);
end;
procedure TControl.ExecuteCancelAction;
begin
end;
@ -1463,8 +1452,6 @@ end;
------------------------------------------------------------------------------}
procedure TControl.DoConstraintsChange(Sender : TObject);
begin
Width:=Constraints.MinMaxWidth(Width);
Height:=Constraints.MinMaxHeight(Height);
AdjustSize;
end;
@ -1916,14 +1903,17 @@ begin
OnShowHint(Self,HintInfo);
end;
procedure TControl.DoScaleFontPPI(const AFont: TFont;
procedure TControl.DoScaleFontPPI(const AFont: TFont; const AToPPI: Integer;
const AProportion: Double);
begin
// If AFont.PixelsPerInch is different from "Screen.PixelsPerInch" (=GetDeviceCaps(DC, LOGPIXELSX))
// then the font doesn't scale -> we have to assign a nonzero height value.
if (AFont.Height=0) and not (csDesigning in ComponentState) then
AFont.Height := MulDiv(GetFontData(AFont.Reference.Handle).Height, AFont.PixelsPerInch, Screen.PixelsPerInch);
AFont.PixelsPerInch := Round(AFont.PixelsPerInch*AProportion);
if AToPPI>0 then
AFont.PixelsPerInch := MulDiv(AFont.PixelsPerInch, AToPPI, AFont.PixelsPerInch)
else
AFont.PixelsPerInch := Round(AFont.PixelsPerInch*AProportion);
end;
function TControl.IsAParentAligning: boolean;
@ -3061,100 +3051,95 @@ begin
// Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DoAutoAdjustLayout'){$ENDIF};
try
if not ParentFont or (Parent=nil) then
ScaleFontsPPI(AYProportion);
// Dimensions
AAWidth := False;
AAHeight := False;
NewLeft := Left;
NewTop := Top;
NewWidth := Width;
NewHeight := Height;
OldWidth := Width;
OldHeight := Height;
// Dimensions
AAWidth := False;
AAHeight := False;
NewLeft := Left;
NewTop := Top;
NewWidth := Width;
NewHeight := Height;
OldWidth := Width;
OldHeight := Height;
ShouldAutoAdjust(AAWidth, AAHeight);
AAWidth := AAWidth and (Align in [alNone, alLeft, alRight])
and not((akLeft in Anchors) and (akRight in Anchors));
AAHeight := AAHeight and (Align in [alNone, alTop, alBottom])
and not((akTop in Anchors) and (akBottom in Anchors));
ShouldAutoAdjust(AAWidth, AAHeight);
AAWidth := AAWidth and (Align in [alNone, alLeft, alRight])
and not((akLeft in Anchors) and (akRight in Anchors));
AAHeight := AAHeight and (Align in [alNone, alTop, alBottom])
and not((akTop in Anchors) and (akBottom in Anchors));
if (Align=alNone) and (akLeft in Anchors) then
NewLeft := Round(NewLeft * AXProportion);
if (Align=alNone) and (akRight in Anchors) and (Parent<>nil)
and (AnchorSideRight.Control=nil) then
if (Align=alNone) and (akLeft in Anchors) then
NewLeft := Round(NewLeft * AXProportion);
if (Align=alNone) and (akRight in Anchors) and (Parent<>nil)
and (AnchorSideRight.Control=nil) then
begin
if not(akLeft in Anchors) then
begin
if not(akLeft in Anchors) then
begin
NewRight := Round((Parent.ClientWidth-NewLeft-OldWidth) * AXProportion);
NewLeft := Parent.ClientWidth-NewRight-OldWidth
end else
begin
NewRight := Round((Parent.ClientWidth-Left-OldWidth) * AXProportion);
NewWidth := Parent.ClientWidth-NewLeft-NewRight;
end;
end;
if (Align=alNone) and (akTop in Anchors) then
NewTop := Round(NewTop * AYProportion);
if (Align=alNone) and (akBottom in Anchors) and (Parent<>nil)
and (AnchorSideBottom.Control=nil) then
NewRight := Round((Parent.ClientWidth-NewLeft-OldWidth) * AXProportion);
NewLeft := Parent.ClientWidth-NewRight-OldWidth
end else
begin
if not(akTop in Anchors) then
begin
NewBottom := Round((Parent.ClientHeight-NewTop-OldHeight) * AYProportion);
NewTop := Parent.ClientHeight-NewBottom-OldHeight
end else
begin
NewBottom := Round((Parent.ClientHeight-Top-OldHeight) * AYProportion);
NewHeight := Parent.ClientHeight-NewTop-NewBottom;
end;
NewRight := Round((Parent.ClientWidth-Left-OldWidth) * AXProportion);
NewWidth := Parent.ClientWidth-NewLeft-NewRight;
end;
end;
if AAWidth then
NewWidth := Round(Width * AXProportion);
if AAHeight then
NewHeight := Round(Height * AYProportion);
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
NewBaseLeft := NewLeft;
NewBaseTop := NewTop;
NewBaseWidth := NewWidth;
NewBaseHeight := NewHeight;
NewWidth := Constraints.MinMaxWidth(NewWidth);
NewHeight := Constraints.MinMaxHeight(NewHeight);
if AAWidth or (NewBaseWidth<>NewWidth) then
if (Align=alNone) and (akTop in Anchors) then
NewTop := Round(NewTop * AYProportion);
if (Align=alNone) and (akBottom in Anchors) and (Parent<>nil)
and (AnchorSideBottom.Control=nil) then
begin
if not(akTop in Anchors) then
begin
if akRight in Anchors then
NewLeft := NewLeft-NewWidth+OldWidth;
end;
if AAHeight or (NewBaseHeight<>NewHeight) then
NewBottom := Round((Parent.ClientHeight-NewTop-OldHeight) * AYProportion);
NewTop := Parent.ClientHeight-NewBottom-OldHeight
end else
begin
if akBottom in Anchors then
NewTop := NewTop-NewHeight+OldHeight;
NewBottom := Round((Parent.ClientHeight-Top-OldHeight) * AYProportion);
NewHeight := Parent.ClientHeight-NewTop-NewBottom;
end;
if AAWidth and (akRight in Anchors) then
NewBaseLeft := NewBaseLeft-NewBaseWidth+OldWidth;
if AAHeight and (akBottom in Anchors) then
NewBaseTop := NewBaseTop-NewBaseHeight+OldHeight;
end;
FBaseBounds.Left:=NewBaseLeft;
FBaseBounds.Top:=NewBaseTop;
FBaseBounds.Right:=NewBaseLeft+NewBaseWidth;
FBaseBounds.Bottom:=NewBaseTop+NewBaseHeight;
if AAWidth then
NewWidth := Round(Width * AXProportion);
if AAHeight then
NewHeight := Round(Height * AYProportion);
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
NewBaseLeft := NewLeft;
NewBaseTop := NewTop;
NewBaseWidth := NewWidth;
NewBaseHeight := NewHeight;
NewWidth := Constraints.MinMaxWidth(NewWidth);
NewHeight := Constraints.MinMaxHeight(NewHeight);
if AAWidth or (NewBaseWidth<>NewWidth) then
begin
if akRight in Anchors then
NewLeft := NewLeft-NewWidth+OldWidth;
end;
if AAHeight or (NewBaseHeight<>NewHeight) then
begin
if akBottom in Anchors then
NewTop := NewTop-NewHeight+OldHeight;
end;
if AAWidth and (akRight in Anchors) then
NewBaseLeft := NewBaseLeft-NewBaseWidth+OldWidth;
if AAHeight and (akBottom in Anchors) then
NewBaseTop := NewBaseTop-NewBaseHeight+OldHeight;
FBaseBounds.Left:=NewBaseLeft;
FBaseBounds.Top:=NewBaseTop;
FBaseBounds.Right:=NewBaseLeft+NewBaseWidth;
FBaseBounds.Bottom:=NewBaseTop+NewBaseHeight;
if Parent<>nil then
begin
FBaseParentClientSize.cx:=Parent.ClientWidth;
FBaseParentClientSize.cy:=Parent.ClientHeight;
SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight);
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DoAutoAdjustLayout'){$ENDIF};
end;
SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight);
end;
end;
@ -4107,7 +4092,15 @@ begin
if AFromPPI > 0 then lYProportion := AToPPI / AFromPPI
else lYProportion := 1.0;
DoAutoAdjustLayout(lMode, lXProportion, lYProportion);
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.AutoAdjustLayout'){$ENDIF};
try
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
ScaleFontsPPI(AToPPI, lYProportion);
DoAutoAdjustLayout(lMode, lXProportion, lYProportion);
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.AutoAdjustLayout'){$ENDIF};
end;
end;
// Auto-adjust the layout of controls.

35
lcl/include/customdesigncontrol.inc
View File

@ -46,46 +46,21 @@ begin
// Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.DoAutoAdjustLayout'){$ENDIF};
try
if not ParentFont or (Parent=nil) then
ScaleFontsPPI(AYProportion);
NewWidth := Round(Width*AXProportion);
NewHeight := Round(Height*AYProportion);
NewWidth := Round(Width*AXProportion);
NewHeight := Round(Height*AYProportion);
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
SetBounds(Left, Top, NewWidth, NewHeight);
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.DoAutoAdjustLayout'){$ENDIF};
end;
SetBounds(Left, Top, NewWidth, NewHeight);
end;
end;
procedure TCustomDesignControl.Loaded;
procedure FixChildren(const AParent: TWinControl);
var
I: Integer;
begin
for I := 0 to AParent.ControlCount-1 do
begin
AParent.Controls[I].FixDesignFontsPPI(FDesignTimePPI);
if AParent.Controls[I] is TWinControl then
FixChildren(TWinControl(AParent.Controls[I]));
end;
end;
begin
inherited Loaded;
FPixelsPerInch := FDesignTimePPI;
if Application.Scaled and Scaled then
begin
FixDesignFontsPPI(FDesignTimePPI);
FixChildren(Self);
end;
end;
procedure TCustomDesignControl.SetDesignTimePPI(const ADesignTimePPI: Integer);

30
lcl/include/customform.inc
View File

@ -1208,6 +1208,8 @@ begin
end;
procedure TCustomForm.SetParent(NewParent: TWinControl);
var
ParentForm: TCustomForm;
begin
if Parent = NewParent then exit;
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.SetParent'){$ENDIF};
@ -1216,6 +1218,14 @@ begin
inherited SetParent(NewParent);
if (Parent = nil) and Visible then
HandleNeeded;
if Parent <> nil then
begin
ParentForm := GetParentForm(Self);
if Application.Scaled and (ParentForm<>nil) and ParentForm.Scaled
and (ParentForm.PixelsPerInch<>PixelsPerInch) then
AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, ParentForm.PixelsPerInch, 0, 0);
end;
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.SetParent'){$ENDIF};
end;
@ -2364,11 +2374,23 @@ begin
end;
function TCustomForm.GetMonitor: TMonitor;
var
ParentForm: TCustomForm;
begin
if HandleAllocated then
Result := Screen.MonitorFromWindow(Handle, mdNearest)
else
Result :=Screen.MonitorFromPoint(point(Left,Top));
if Assigned(Parent) then
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) then
Result := ParentForm.Monitor
else
Result := nil;
end else
begin
if HandleAllocated then
Result := Screen.MonitorFromWindow(Handle, mdNearest)
else
Result := Screen.MonitorFromPoint(point(Left,Top));
end;
end;
{------------------------------------------------------------------------------

1
lcl/include/customlistview.inc
View File

@ -1124,6 +1124,7 @@ begin
FViewOriginCache := TWSCustomListViewClass(WidgetSetClass).GetViewOrigin(Self);
if not OwnerData then
FListItems.DoFinalizeWnd;
Columns.DoFinalizeWnd;
inherited FinalizeWnd;
end;

2
lcl/include/listcolumn.inc
View File

@ -178,7 +178,7 @@ begin
else
if (MaxWidth > 0) and (W > MaxWidth) then
W := MaxWidth;
if FWidth = W then Exit;
if Width = W then Exit; // compare with Width instead of FWidth - FWidth is not updated from the WS automatically
FWidth := W;
Changed(False);
if not WSUpdateAllowed then Exit;

8
lcl/include/listcolumns.inc
View File

@ -62,6 +62,14 @@ begin
EndUpdate;
end;
procedure TListColumns.DoFinalizeWnd;
var
I: Integer;
begin
for I := 0 to Count-1 do
Items[I].GetWidth; // store real width from WS into FWidth
end;
procedure TListColumns.Update(Item: TCollectionItem);
begin
if (Item = nil) and FNeedsUpdate then

1
lcl/include/wincontrol.inc
View File

@ -2553,6 +2553,7 @@ var
or (CurControl.Anchors <> [akLeft, akTop])
or (CurControl.AnchorSide[akLeft].Control<>nil)
or (CurControl.AnchorSide[akTop].Control<>nil)
or (cfAutoSizeNeeded in CurControl.FControlFlags)
or (ChildSizing.Layout<>cclNone)
then Exit;
end;