Recent

Author Topic: TActionList.Images scaling for high DPI  (Read 2731 times)

Max V. Terentiev

  • New Member
  • *
  • Posts: 30
TActionList.Images scaling for high DPI
« on: November 28, 2019, 05:10:14 pm »
Hi,

I have TActionList.Images linked to multi-resolution TImageList with icons in 16x16 and 32x32 resolutions.

And I have TSpeedButton linked to Action from ActionList. ImageIndex is set in Action.

As result icon on SpeedButton NOT scaled with 150ppi screen setting !

But if I link ImageList directly to TSpeedButton and set ImageIndex on it - icon scaled as expected.

In attachement first button from ImageList linked to ActionList, second button - ImageList linked to TSpeedButton.

It's Lazarus bug or feature ? Any workaround for correct scaling ? I have about 100 actions with assigned ImageIndex, not want to re-assign them to buttons and other controls...

Lazarus 2.0.6, Windows 10 x64

« Last Edit: November 28, 2019, 05:11:53 pm by Max V. Terentiev »

abtaylr

  • Full Member
  • ***
  • Posts: 107
Re: TActionList.Images scaling for high DPI
« Reply #1 on: November 28, 2019, 06:01:09 pm »
How about as a starting point something like:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.       Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.                         ExtDlgs;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.           ButtonClose : TButton;
  17.                 Image1 : TImage;
  18.                 Image2 : TImage;
  19.  
  20.                 procedure ButtonCloseClick(Sender : TObject);
  21.   private
  22.  
  23.   public
  24.  
  25. end;
  26.  
  27. var
  28.       Form1 : TForm1;
  29.  
  30. implementation
  31.  
  32. {$R *.lfm}
  33.  
  34. { TForm1 }
  35.  
  36. procedure TForm1.ButtonCloseClick(Sender : TObject);
  37. begin
  38.   Close;
  39. end;
  40.  
  41. end.
  42.  

In the Object inspector I had to change the properties:

Code: Pascal  [Select][+][-]
  1. unit1.lfm
  2. object Form1: TForm1
  3.   Left = 375
  4.   Height = 576
  5.   Top = 250
  6.   Width = 567
  7.   Caption = 'Form1'
  8.   ClientHeight = 576
  9.   ClientWidth = 567
  10.   LCLVersion = '2.0.6.0'
  11.   object Image1: TImage
  12.     Left = 24
  13.     Height = 362
  14.     Top = 24
  15.     Width = 456
  16.     Picture.Data = {  xxx pixels xxx }
  17.     Proportional = True
  18.   end
  19.   object Image2: TImage
  20.     Left = 24
  21.     Height = 90
  22.     Top = 416
  23.     Width = 90
  24.     Picture.Data = { xxx pxels xxx}
  25.  }
  26.     Stretch = True
  27.   end
  28.   object ButtonConvert: TButton
  29.     Left = 376
  30.     Height = 25
  31.     Top = 416
  32.     Width = 75
  33.     Caption = 'Convert'
  34.     OnClick = ButtonConvertClick
  35.     TabOrder = 0
  36.   end
  37.   object ButtonClose: TButton
  38.     Left = 376
  39.     Height = 25
  40.     Top = 488
  41.     Width = 75
  42.     Caption = 'Close'
  43.     OnClick = ButtonCloseClick
  44.     TabOrder = 1
  45.   end
  46.   object OpenPictureDialog1: TOpenPictureDialog
  47.     left = 216
  48.     top = 416
  49.   end
  50. end
  51.  

You can also change the DesignTimePPI and PixelsPerInch
I used your jpeg file and the form made the scaling for me.

wp

  • Hero Member
  • *****
  • Posts: 11854
Re: TActionList.Images scaling for high DPI
« Reply #2 on: November 28, 2019, 07:07:10 pm »
It's Lazarus bug or feature ?
A bug. The speedbutton did not request the bitmap for the needed resolution from the action. I fixed it in r62311 and requested backporting to the fixes branch.

You can fix it in your v2.0.6 easily:
  • Open file speedbutton.inc (in folder lcl/include of your Lazarus installation).
  • Find procedure TCustomSpeedButton.ActionChange and replace it by this code:
Code: Pascal  [Select][+][-]
  1. procedure TCustomSpeedButton.ActionChange(Sender: TObject;
  2.   CheckDefaults: Boolean);
  3. var
  4.   ImagesRes: TScaledImageListResolution;
  5. begin
  6.   inherited ActionChange(Sender,CheckDefaults);
  7.   if Sender is TCustomAction then
  8.   begin
  9.     with TCustomAction(Sender) do
  10.     begin
  11.       if CheckDefaults or (Self.GroupIndex = 0) then
  12.         Self.GroupIndex := GroupIndex;
  13.       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
  14.          (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
  15.       begin
  16.         ImagesRes := ActionList.Images.ResolutionForPPI[ImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
  17.         ImagesRes.GetBitmap(ImageIndex, Glyph);
  18.       end;
  19.     end;
  20.   end;
  21. end;
  • Repeat also with TBitBtn (file lcl/include/bitbtn.inc):
Code: Pascal  [Select][+][-]
  1. procedure TCustomBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  2. var
  3.   ImagesRes: TScaledImageListResolution;
  4. begin
  5.   inherited ActionChange(Sender,CheckDefaults);
  6.   if Sender is TCustomAction then
  7.   begin
  8.     with TCustomAction(Sender) do
  9.     begin
  10.       if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
  11.         (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
  12.       begin
  13.         ImagesRes := ActionList.Images.ResolutionForPPI[ImageWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
  14.         ImagesRes.GetBitmap(ImageIndex, Glyph);
  15.       end;
  16.     end;
  17.   end;
  18. end;
    Please test and report if this code fixes the issue for you, too.

    jamie

    • Hero Member
    • *****
    • Posts: 6090
    Re: TActionList.Images scaling for high DPI
    « Reply #3 on: November 28, 2019, 07:14:11 pm »
    Oh, you're such nice a nice guy!

    Happy Turkey Day! (At least in the states)  :D
    The only true wisdom is knowing you know nothing

    Max V. Terentiev

    • New Member
    • *
    • Posts: 30
    Re: TActionList.Images scaling for high DPI
    « Reply #4 on: November 28, 2019, 10:39:50 pm »
    Quote
    Please test and report if this code fixes the issue for you, too.

    Yes, it's fixes problem ! Thank you very very much for help !

    Lazarus community is great !! ))

     

    TinyPortal © 2005-2018