Skip to content

Commit

Permalink
Fixes for issue #677 (DPI awareness with different monitor DPIs):
Browse files Browse the repository at this point in the history
* TBaseVirtualTree.ChangeScale() now scales the node heights too
* TBaseVirtualTree.ChangeScale() now uses DefaultScalingFlags in case of a dpi scaling, just like TControl.ChangeScale() does it.
* TBaseVirtualTree.ChangeScale() now calls AutoScale() after calling inherited, to ensure that the Font has been updated.
  • Loading branch information
Joachim Marder committed Jan 9, 2017
1 parent a381b33 commit d3f2815
Showing 1 changed file with 27 additions and 13 deletions.
40 changes: 27 additions & 13 deletions Source/VirtualTrees.pas
Original file line number Diff line number Diff line change
Expand Up @@ -18466,22 +18466,36 @@ procedure TBaseVirtualTree.Change(Node: PVirtualNode);
//----------------------------------------------------------------------------------------------------------------------

procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend});

var
Flags: TScalingFlags;
Run: PVirtualNode;
begin
if (toAutoChangeScale in FOptions.FAutoOptions) then
begin
if (M <> D) then
begin
if sfHeight in ScalingFlags then begin
// It is important to evaluate the TScalingFlags before calling inherited, becuase they are differetn afterwards!
if csLoading in ComponentState then
Flags := ScalingFlags
else
Flags := DefaultScalingFlags; // Important for #677
if (sfHeight in Flags) then begin
FHeader.ChangeScale(M, D);
SetDefaultNodeHeight(MulDiv(FDefaultNodeHeight, M, D));
end;
if sfHeight in ScalingFlags then
Indent := MulDiv(Indent, M, D);
// Scale also node heights
Run := GetFirstInitialized;
while Assigned(Run) do
begin
Run.NodeHeight := MulDiv(Run.NodeHeight, M, D);
Run := GetNextInitialized(Run);
end; // while
end;//if sfHeight
end;// if M<>D
AutoScale(M <> D);
end;//if toAutoChangeScale
inherited ChangeScale(M, D{$if CompilerVersion >= 31}, isDpiChange{$ifend});
// It is important to do this call after calling inherited, so that the Font has been updated.
AutoScale(M <> D);
end;

//----------------------------------------------------------------------------------------------------------------------
Expand Down Expand Up @@ -19643,15 +19657,15 @@ procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex);

begin
if not (csLoading in ComponentState) and HandleAllocated then
begin
// Reset all vsHeightMeasured flags if we are in multiline mode.
Run := GetFirstInitialized;
while Assigned(Run) do
begin
// Reset all vsHeightMeasured flags if we are in multiline mode.
Run := GetFirstInitialized;
while Assigned(Run) do
begin
if vsMultiline in Run.States then
Exclude(Run.States, vsHeightMeasured);
Run := GetNextInitialized(Run);
end;
Exclude(Run.States, vsHeightMeasured);
Run := GetNextInitialized(Run);
end;

UpdateHorizontalScrollBar(True);
if Column > NoColumn then
Expand Down Expand Up @@ -25982,7 +25996,7 @@ procedure TBaseVirtualTree.AutoScale(isDpiChange: Boolean);
lTextHeight := Canvas.TextHeight('Tg');
// By default, we only ensure that DefaultNodeHeight is large enough.
// If the form's dpi has changed, we scale up and down the DefaultNodeHeight, See issue #677.
if (lTextHeight > Self.DefaultNodeHeight) or (isDpiChange and (lTextHeight <> Self.DefaultNodeHeight)) then
if (lTextHeight > Self.DefaultNodeHeight) then
Self.DefaultNodeHeight := lTextHeight;
end;
end;
Expand Down

0 comments on commit d3f2815

Please sign in to comment.