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

lcl: headercontrol: High-DPI. Issue #31429, patch by Anton Kavalenka

Browse Source 
git-svn-id: trunk@54224 -
This commit is contained in:
ondrej 2017-02-21 13:58:19 +00:00
parent b64d6fc80e
commit d6983d5300
2 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/comctrls.pp
View File

@ -3874,6 +3874,8 @@ type
X, Y: Integer); override;
procedure UpdateState;
class function GetControlClassDefaultSize: TSize; override;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
public
property SectionFromOriginalIndex[OriginalIndex: Integer]: THeaderSection read GetSectionFromOriginalIndex;

25
lcl/include/headercontrol.inc
View File

@ -412,11 +412,34 @@ begin
Images, Section.ImageIndex);
inc(ContentRect.Left, Images.Width + 2);
end;
if Section.Text <> '' then
ThemeServices.DrawText(Canvas, Details, Section.Text, ContentRect, AlignmentMap[Section.Alignment] or DT_VCENTER or DT_SINGLELINE, 0);
end;
procedure TCustomHeaderControl.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
var
I: integer;
Sect: THeaderSection;
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
Sections.BeginUpdate;
try
for I := 0 to Sections.Count-1 do
begin
Sect := Sections.Items[I];
Sect.Width := Round(Sect.Width*AXProportion);
end;
finally
Sections.EndUpdate;
end;
end;
end;
procedure TCustomHeaderControl.ChangeScale(M, D: Integer);
var
I: integer;