paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 13:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Fix TSpeedButton and TBitBtn using non-scaled icons if an Action is assigned to these controls (https://forum.lazarus.freepascal.org/index.php/topic,47574.msg340909.html).

Browse Source 
git-svn-id: trunk@62311 -
This commit is contained in:
wp 2019-11-28 17:58:24 +00:00
parent bb24841e59
commit 733d74e407
2 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/include/bitbtn.inc
View File

@ -200,6 +200,8 @@ begin
end;
procedure TCustomBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
var
ImagesRes: TScaledImageListResolution;
begin
inherited ActionChange(Sender,CheckDefaults);
if Sender is TCustomAction then
@ -208,7 +210,10 @@ begin
begin
if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
ActionList.Images.GetBitmap(ImageIndex, Glyph);
begin
ImagesRes := ActionList.Images.ResolutionForPPI[ImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
ImagesRes.GetBitmap(ImageIndex, Glyph);
end;
end;
end;
end;

7
lcl/include/speedbutton.inc
View File

@ -419,6 +419,8 @@ end;
procedure TCustomSpeedButton.ActionChange(Sender: TObject;
CheckDefaults: Boolean);
var
ImagesRes: TScaledImageListResolution;
begin
inherited ActionChange(Sender,CheckDefaults);
if Sender is TCustomAction then
@ -429,7 +431,10 @@ begin
Self.GroupIndex := GroupIndex;
if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
ActionList.Images.GetBitmap(ImageIndex, Glyph);
begin
ImagesRes := ActionList.Images.ResolutionForPPI[ImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
ImagesRes.GetBitmap(ImageIndex, Glyph);
end;
end;
end;
end;