paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 10:40:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: treeview: High-DPI: expand size fix

Browse Source 
git-svn-id: trunk@54232 -
This commit is contained in:
ondrej 2017-02-21 18:38:54 +00:00
parent 3993478d43
commit 0471421a18
2 changed files with 28 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/comctrls.pp
View File

@ -3251,7 +3251,7 @@ type
FEditingItem: TTreeNode;
FExpandSignType: TTreeViewExpandSignType;
FExpandSignSize: integer;
FRealExpandSignSize: integer;
FThemeExpandSignSize: integer;
FDefItemHeight: integer;
FDragImage: TDragImageList;
FDragNode: TTreeNode;
@ -3324,6 +3324,7 @@ type
function GetKeepCollapsedNodes: boolean;
function GetMultiSelect: Boolean;
function GetReadOnly: boolean;
function GetRealExpandSignSize: integer;
function GetRightClickSelect: boolean;
function GetRowSelect: boolean;
function GetSelection: TTreeNode;
@ -3377,7 +3378,6 @@ type
procedure SetTopItem(Value: TTreeNode);
procedure UpdateAllTops;
procedure UpdateBottomItem;
procedure UpdateRealExpandSignSize;
procedure UpdateMaxLvl;
procedure UpdateMaxRight;
procedure UpdateTopItem;
@ -3408,7 +3408,6 @@ type
Stage: TCustomDrawStage): Boolean; virtual;
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual;
procedure FontChanged(Sender: TObject); override;
function GetDragImages: TDragImageList; override;
function GetMaxLvl: integer;
function GetMaxScrollLeft: integer;

63
lcl/include/treeview.inc
View File

@ -3191,6 +3191,8 @@ end;
{ TCustomTreeView }
constructor TCustomTreeView.Create(AnOwner: TComponent);
var
Details: TThemedElementDetails;
begin
inherited Create(AnOwner);
ControlStyle := ControlStyle - [csCaptureMouse]
@ -3207,6 +3209,8 @@ begin
FDefItemHeight := DefaultTreeNodeHeight;
FExpandSignType := tvestTheme;
FExpandSignSize := -1;
Details := ThemeServices.GetElementDetails(ttGlyphOpened);
FThemeExpandSignSize := ThemeServices.GetDetailSize(Details).cx;
FTreeNodes := CreateNodes;
BorderStyle := bsSingle;
BorderWidth := 0;
@ -3236,7 +3240,6 @@ begin
AccessibleDescription := rsTTreeViewAccessibilityDescription;
AccessibleRole := larTreeView;
FAccessibilityOn := WidgetSet.GetLCLCapability(lcAccessibilitySupport) = LCL_CAPABILITY_YES;
UpdateRealExpandSignSize;
end;
destructor TCustomTreeView.Destroy;
@ -4408,28 +4411,11 @@ begin
Result:=(tvoToolTips in FOptions);
end;
procedure TCustomTreeView.UpdateRealExpandSignSize;
var
Details: TThemedElementDetails;
begin
if FExpandSignSize>=0 then
FRealExpandSignSize := FExpandSignSize
else
if ExpandSignType = tvestTheme then
begin
Details := ThemeServices.GetElementDetails(ttGlyphOpened);
FRealExpandSignSize := MulDiv(ThemeServices.GetDetailSize(Details).cx, Font.PixelsPerInch, Screen.PixelsPerInch);
end
else
FRealExpandSignSize := DefaultTreeNodeExpandSignSize;
end;
procedure TCustomTreeView.SetExpandSignType(Value: TTreeViewExpandSignType);
begin
if Value <> FExpandSignType then
begin
FExpandSignType := Value;
UpdateRealExpandSignSize;
Invalidate;
end;
end;
@ -4499,6 +4485,17 @@ begin
Result:=(tvoReadOnly in FOptions);
end;
function TCustomTreeView.GetRealExpandSignSize: integer;
begin
if FExpandSignSize>=0 then
Result := FExpandSignSize
else
if ExpandSignType = tvestTheme then
Result := MulDiv(FThemeExpandSignSize, Font.PixelsPerInch, Screen.PixelsPerInch)
else
Result := DefaultTreeNodeExpandSignSize;
end;
function TCustomTreeView.GetRightClickSelect: boolean;
begin
Result:=(tvoRightClickSelect in FOptions);
@ -4522,7 +4519,7 @@ procedure TCustomTreeView.SetExpandSignSize(const AExpandSignSize: integer);
begin
if FExpandSignSize = AExpandSignSize then Exit;
FExpandSignSize := AExpandSignSize;
UpdateRealExpandSignSize;
Invalidate;
end;
function TCustomTreeView.IsEditing: Boolean;
@ -4749,7 +4746,7 @@ end;
procedure TCustomTreeView.DoPaintNode(Node: TTreeNode);
var
NodeRect: TRect;
VertMid, VertDelta: integer;
VertMid, VertDelta, RealExpandSignSize: integer;
NodeSelected, HasExpandSign: boolean;
function InvertColor(AColor: TColor): TColor;
@ -4824,7 +4821,7 @@ var
begin
// draw horizontal line
if HasExpandSign then
DrawHorzLine(VertMid, CurMid + FRealExpandSignSize div 2, Result + Indent)
DrawHorzLine(VertMid, CurMid + RealExpandSignSize div 2, Result + Indent)
else
DrawHorzLine(VertMid, CurMid, Result + Indent);
end;
@ -4835,11 +4832,11 @@ var
if (CurNode = Node) and HasExpandSign then
begin
if (Node.Parent = nil) and (Node.GetPrevSibling = nil) then
DrawVertLine(CurMid, VertMid + FRealExpandSignSize div 2, NodeRect.Bottom)
DrawVertLine(CurMid, VertMid + RealExpandSignSize div 2, NodeRect.Bottom)
else
begin
DrawVertLine(CurMid, NodeRect.Top, VertMid);
DrawVertLine(CurMid, VertMid + FRealExpandSignSize div 2 + VertDelta, NodeRect.Bottom);
DrawVertLine(CurMid, VertMid + RealExpandSignSize div 2 + VertDelta, NodeRect.Bottom);
end;
end
else
@ -4856,7 +4853,7 @@ var
if ((InsertMarkNode = Node) and (InsertMarkType = tvimAsNextSibling)) then
begin
DrawVertLine(CurMid, NodeRect.Top, VertMid);
DrawVertLine(CurMid, VertMid + FRealExpandSignSize div 2, NodeRect.Bottom - 1);
DrawVertLine(CurMid, VertMid + RealExpandSignSize div 2, NodeRect.Bottom - 1);
end
else
DrawVertLine(CurMid, NodeRect.Top, VertMid);
@ -4893,13 +4890,13 @@ var
const
cShiftHorzArrow = 2; //paint horz arrow N pixels upper than MidY
begin
HalfSize := FRealExpandSignSize div 2;
if not Odd(FRealExpandSignSize) then
HalfSize := RealExpandSignSize div 2;
if not Odd(RealExpandSignSize) then
Dec(HalfSize);
ALeft := MidX - HalfSize;
ATop := MidY - HalfSize;
ARight := ALeft + FRealExpandSignSize;
ABottom := ATop + FRealExpandSignSize;
ARight := ALeft + RealExpandSignSize;
ABottom := ATop + RealExpandSignSize;
if Assigned(FOnCustomDrawArrow) then
begin
@ -5127,6 +5124,7 @@ var
PaintImages: boolean;
OverlayIndex: Integer;
begin
RealExpandSignSize := RealExpandSignSize;
NodeRect := Node.DisplayRect(False);
if (NodeRect.Bottom < 0) or (NodeRect.Top >= ClientHeight) then
Exit;
@ -5288,13 +5286,6 @@ begin
if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
end;
procedure TCustomTreeView.FontChanged(Sender: TObject);
begin
UpdateRealExpandSignSize;
inherited FontChanged(Sender);
end;
function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
Result := True;
@ -5986,8 +5977,6 @@ var OldMaxRight, OldLastTop, OldMaxLvl: integer;
begin
if Canvas=nil then
RaiseGDBException('Canvas=nil');
if (FRealExpandSignSize<0) then
RaiseGDBException('FRealExpandSignSize='+IntToStr(FRealExpandSignSize));
if FDefItemHeight<0 then
RaiseGDBException('FDefItemHeight='+IntToStr(FDefItemHeight));
if FIndent<0 then