paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 02:17:15 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL: A new filled arrow style for TreeView. Issue #27465, patch from Alexey Torgashin.

Browse Source 
git-svn-id: trunk@47770 -
This commit is contained in:
juha 2015-02-14 09:36:36 +00:00
parent 20a1bf3a5f
commit 2fbfba12ac
2 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/comctrls.pp
View File

@ -3144,7 +3144,8 @@ type
TTreeViewExpandSignType = (
tvestTheme, // use themed sign
tvestPlusMinus, // use +/- sign
tvestArrow // use arrow
tvestArrow, // use blank arrow
tvestArrowFill // use filled arrow
);
TTreeViewInsertMarkType = (

23
lcl/include/treeview.inc
View File

@ -4700,6 +4700,9 @@ var
Points: PPoint;
Details: TThemedElementDetails;
R: TRect;
PrevColor: TColor;
const
cShiftHorzArrow = 2; //paint horz arrow N pixels upper than MidY
begin
with Canvas do
begin
@ -4733,7 +4736,8 @@ var
LineTo(MidX, R.Bottom - 2);
end;
end;
tvestArrow:
tvestArrow,
tvestArrowFill:
begin
// draw an arrow. down for collapse and right for expand
R := Rect(ALeft, ATop, ARight, ABottom);
@ -4741,9 +4745,9 @@ var
if CollapseSign then
begin
// draw an arrow down
Points[0] := Point(R.Left, MidY);
Points[1] := Point(R.Right - 1, MidY);
Points[2] := Point(MidX, R.Bottom - 1);
Points[0] := Point(R.Left, MidY - cShiftHorzArrow);
Points[1] := Point(R.Right - 1, MidY - cShiftHorzArrow);
Points[2] := Point(MidX, R.Bottom - 1 - cShiftHorzArrow);
end else
begin
// draw an arrow right
@ -4751,7 +4755,18 @@ var
Points[1] := Point(R.Right - 2, MidY);
Points[2] := Point(MidX - 1, R.Bottom - 1);
end;
if ExpandSignType = tvestArrowFill then
begin
PrevColor := Brush.Color;
Brush.Color := ExpandSignColor;
end;
Polygon(Points, 3, False);
if ExpandSignType = tvestArrowFill then
begin
Brush.Color := PrevColor;
end;
FreeMem(Points);
end;
end;