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

Aktualisieren lcl/include/bitbtn.inc

Browse Source
This commit is contained in:
Roland Hahn 2021-11-07 10:26:45 +00:00
parent 2f07ee8783
commit 5aee9d5c07
1 changed files with 2 additions and 9 deletions

11
lcl/include/bitbtn.inc
View File

@ -203,23 +203,16 @@ procedure TCustomBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
var
NewAct: TCustomAction;
Imgs: TCustomImageList;
ImgRes: TScaledImageListResolution;
begin
inherited ActionChange(Sender,CheckDefaults);
if Sender is TCustomAction then
begin
NewAct := TCustomAction(Sender);
//DebugLn(['TCustomBitBtn.ActionChange: Glyph.Empty=', Glyph.Empty,
// ', Action=', NewAct.Caption,
// ', ActionList=', NewAct.ActionList,
// ', Images=', NewAct.ActionList.Images,
// ', ImageIndex=', NewAct.ImageIndex ]);
if (NewAct.ActionList = nil) or (NewAct.ImageIndex < 0) then Exit;
Imgs := NewAct.ActionList.Images;
if (Imgs = nil) or (NewAct.ImageIndex >= Imgs.Count) then Exit;
//DebugLn([' TCustomBitBtn.ActionChange: Setting image, ImageWidth=', ImageWidth]);
ImgRes := Imgs.ResolutionForPPI[ImageWidth,Font.PixelsPerInch,GetCanvasScaleFactor];
ImgRes.GetBitmap(NewAct.ImageIndex, Glyph);
Images := Imgs;
ImageIndex := NewAct.ImageIndex;
end;
end;