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

Merge branch 'sesvena-main-patch-25197' into 'main'

Browse Source 
lcl: fixed TBitButton with Action and changing Action.ImageIndex

See merge request freepascal.org/lazarus/lazarus!45
This commit is contained in:
Juha Manninen 2021-11-07 14:04:24 +00:00
commit 27d3cf84dd
1 changed files with 2 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/include/bitbtn.inc
View File

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