LCL: TBitBtn: support high-resolution Kind images. Issue #33645

git-svn-id: trunk@57706 -

.gitattributes

@@ -8307,17 +8307,38 @@ lcl/images/btntime.png -text svneol=unset#image/png
 lcl/images/btntime_150.png -text svneol=unset#image/png
 lcl/images/btntime_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_abort.png -text svneol=unset#image/png
+lcl/images/buttons/btn_abort_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_abort_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_all.png -text svneol=unset#image/png
+lcl/images/buttons/btn_all_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_all_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_arrowright.png -text
 lcl/images/buttons/btn_cancel.png -text svneol=unset#image/png
+lcl/images/buttons/btn_cancel_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_cancel_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_close.png -text svneol=unset#image/png
+lcl/images/buttons/btn_close_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_close_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_help.png -text svneol=unset#image/png
+lcl/images/buttons/btn_help_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_help_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_ignore.png -text svneol=unset#image/png
+lcl/images/buttons/btn_ignore_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_ignore_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_no.png -text svneol=unset#image/png
+lcl/images/buttons/btn_no_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_no_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_ok.png -text svneol=unset#image/png
+lcl/images/buttons/btn_ok_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_ok_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_retry.png -text svneol=unset#image/png
+lcl/images/buttons/btn_retry_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_retry_200.png -text svneol=unset#image/png
 lcl/images/buttons/btn_yes.png -text svneol=unset#image/png
-lcl/images/buttons/build.bat svneol=native#text/x-msdos-program
+lcl/images/buttons/btn_yes_150.png -text svneol=unset#image/png
+lcl/images/buttons/btn_yes_200.png -text svneol=unset#image/png
+lcl/images/buttons/lcl_btn_images.bat svneol=native#text/plain
+lcl/images/buttons/lcl_btn_images_list.txt svneol=native#text/plain
 lcl/images/copyright.txt svneol=native#text/plain
 lcl/images/cursors/build.bat svneol=native#text/x-msdos-program
 lcl/images/cursors/cur_1.cur -text svneol=unset#image/x-cursor

lcl/buttons.pp

@@ -164,7 +164,7 @@ type
     procedure SetMargin(const AValue: integer);
     procedure SetNumGlyphs(AValue: Integer);
     procedure SetSpacing(AValue: Integer);
-    procedure RealizeKind;
+    procedure RealizeKind(ForceDefaults: Boolean);
     //Return the caption associated with the aKind value.
     function GetCaptionOfKind(AKind: TBitBtnKind): String;
     function GetImages: TCustomImageList;
@@ -446,6 +446,15 @@ type
     property PopupMenu;
   end;
 
+  TLCLBtnGlyphs = class(TImageList)
+  private
+    FImageIndexes: array[TBitBtnKind] of Integer;
+  public
+    function GetImageIndex(Kind: TBitBtnKind): Integer;
+
+    constructor Create(AOwner: TComponent); override;
+  end;
+
   { To override the default TBitBtn glyphs set GetDefaultBitBtnGlyph below.
     Example:
 
@@ -473,12 +482,14 @@ procedure LoadGlyphFromStock(AGlyph: TButtonGlyph; idButton: Integer);
 
 // helper functions (search LCLType for idButton)
 function GetButtonCaption(idButton: Integer): String;
-function GetDefaultButtonIcon(idButton: Integer): TCustomBitmap;
+function GetDefaultButtonIcon(idButton: Integer; ScalePercent: Integer = 100): TCustomBitmap;
 function GetButtonIcon(idButton: Integer): TCustomBitmap;
 function BidiAdjustButtonLayout(IsRightToLeft: Boolean; Layout: TButtonLayout): TButtonLayout;
 
 function dbgs(Kind: TBitBtnKind): string; overload;
 
+function LCLBtnGlyphs: TLCLBtnGlyphs;
+
 procedure Register;
 
 const
@@ -508,6 +519,9 @@ const
 {idButtonNoToAll } 'btn_no'
   );
 
+var
+  GLCLBtnGlyphs: TLCLBtnGlyphs = nil;
+
 implementation
 
 {$R btn_icons.res}
@@ -520,7 +534,10 @@ begin
   Result := GetDefaultButtonIcon(BitBtnImages[Kind]);
 end;
 
-function GetDefaultButtonIcon(idButton: Integer): TCustomBitmap;
+function GetDefaultButtonIcon(idButton: Integer;
+  ScalePercent: Integer): TCustomBitmap;
+var
+  ResName: string;
 begin
   Result := nil;
   if (idButton < Low(BitBtnResNames)) or (idButton > High(BitBtnResNames)) then
@@ -528,7 +545,10 @@ begin
   if BitBtnResNames[idButton] = '' then
     Exit;
   Result := TPortableNetworkGraphic.Create;
-  Result.LoadFromResourceName(hInstance, BitBtnResNames[idButton]);
+  ResName := BitBtnResNames[idButton];
+  if Application.Scaled and (ScalePercent<>100) then
+    ResName := ResName+'_'+IntToStr(ScalePercent);
+  Result.LoadFromResourceName(hInstance, ResName);
 end;
 
 procedure LoadGlyphFromResourceName(AGlyph: TButtonGlyph; Instance: THandle; const AName: String);
@@ -641,13 +661,70 @@ begin
   writestr(Result,Kind);
 end;
 
+function LCLBtnGlyphs: TLCLBtnGlyphs;
+begin
+  if GLCLBtnGlyphs=nil then
+    GLCLBtnGlyphs := TLCLBtnGlyphs.Create(nil);
+  Result := GLCLBtnGlyphs;
+end;
+
 procedure Register;
 begin
   RegisterComponents('Additional',[TBitBtn,TSpeedButton]);
 end;
 
+{ TLCLBtnGlyphs }
+
+constructor TLCLBtnGlyphs.Create(AOwner: TComponent);
+var
+  K: TBitBtnKind;
+
+  function AddBtnImage(ScalePercent: Integer): Boolean;
+  var
+    G: TCustomBitmap;
+  begin
+    G := GetDefaultButtonIcon(BitBtnImages[K], ScalePercent);
+    Result := G<>nil;
+    if Result then
+    try
+      if ScalePercent=100 then
+        Add(G, nil)
+      else
+        Replace(Count-1, G, nil, False);
+    finally
+      G.Free;
+    end;
+  end;
+begin
+  inherited Create(AOwner);
+
+  RegisterResolutions([16, 24, 32]);
+  for K in TBitBtnKind do
+  begin
+    if AddBtnImage(100) then
+    begin
+      AddBtnImage(150);
+      AddBtnImage(200);
+      FImageIndexes[K] := Count-1;
+    end else
+      FImageIndexes[K] := -1;
+  end;
+
+  Scaled := True;
+end;
+
+function TLCLBtnGlyphs.GetImageIndex(Kind: TBitBtnKind): Integer;
+begin
+  Result := FImageIndexes[Kind];
+end;
+
 {$I bitbtn.inc}
 {$I buttonglyph.inc}
 {$I speedbutton.inc}
 
+initialization
+
+finalization
+  FreeAndNil(GLCLBtnGlyphs);
+
 end.

lcl/images/buttons/build.bat

@@ -1 +0,0 @@
-..\..\..\tools\lazres ..\..\btn_icons.res btn_abort.png btn_all.png btn_cancel.png btn_close.png btn_help.png btn_ignore.png btn_no.png btn_ok.png btn_retry.png btn_yes.png btn_arrowright.png

lcl/images/buttons/lcl_btn_images.bat

@@ -0,0 +1 @@
+..\..\..\tools\lazres ..\..\btn_icons.res @lcl_btn_images_list.txt

lcl/images/buttons/lcl_btn_images_list.txt

@@ -0,0 +1,31 @@
+btn_abort.png
+btn_abort_150.png
+btn_abort_200.png
+btn_all.png
+btn_all_150.png
+btn_all_200.png
+btn_cancel.png
+btn_cancel_150.png
+btn_cancel_200.png
+btn_close.png
+btn_close_150.png
+btn_close_200.png
+btn_help.png
+btn_help_150.png
+btn_help_200.png
+btn_ignore.png
+btn_ignore_150.png
+btn_ignore_200.png
+btn_no.png
+btn_no_150.png
+btn_no_200.png
+btn_ok.png
+btn_ok_150.png
+btn_ok_200.png
+btn_retry.png
+btn_retry_150.png
+btn_retry_200.png
+btn_yes.png
+btn_yes_150.png
+btn_yes_200.png
+btn_arrowright.png

lcl/include/bitbtn.inc

@@ -28,7 +28,6 @@ begin
   FImageChangeLink := TChangeLink.Create;
   FImageChangeLink.OnChange := @ImageListChange;
   Align := alNone;
-  RealizeKind;
 end;
 
 {------------------------------------------------------------------------------
@@ -110,12 +109,18 @@ end;
 
 function TCustomBitBtn.GetImageIndex: Integer;
 begin
-  Result := FButtonGlyph.ExternalImageIndex;
+  if FButtonGlyph.ExternalImages=GLCLBtnGlyphs then
+    Result := 0
+  else
+    Result := FButtonGlyph.ExternalImageIndex;
 end;
 
 function TCustomBitBtn.GetImages: TCustomImageList;
 begin
-  Result := FButtonGlyph.ExternalImages;
+  if FButtonGlyph.ExternalImages=GLCLBtnGlyphs then
+    Result := nil
+  else
+    Result := FButtonGlyph.ExternalImages;
 end;
 
 function TCustomBitBtn.GetImageWidth: Integer;
@@ -218,8 +223,8 @@ procedure TCustomBitBtn.SetKind(AValue: TBitBtnKind);
 begin
   if FKind = AValue then Exit;
   FKind := AValue;
-  if FKind <> bkCustom then
-    RealizeKind;
+  if (FKind <> bkCustom) and not (csLoading in ComponentState) then
+    RealizeKind(True);
   if not (csLoading in ComponentState) then
     DefaultCaption := FKind <> bkCustom;
 end;
@@ -270,7 +275,7 @@ begin
     Invalidate;
 end;
 
-procedure TCustomBitBtn.RealizeKind;
+procedure TCustomBitBtn.RealizeKind(ForceDefaults: Boolean);
 var
   GlyphValid, Handled: Boolean;
   CustomGlyph: TGraphic;
@@ -306,17 +311,16 @@ begin
     
     if not GlyphValid then
     begin
-      CustomGlyph := GetLCLDefaultBtnGlyph(Kind);
-      if CustomGlyph <> nil then
+      if ForceDefaults or (Images=nil) then
       begin
-        Glyph.Assign(CustomGlyph);
-        CustomGlyph.Free;
+        Images := LCLBtnGlyphs;
+        ImageIndex := LCLBtnGlyphs.GetImageIndex(Kind);
         GlyphValid := True;
       end;
     end;
   end;
 
-  if not (csLoading in ComponentState) then
+  if ForceDefaults then
   begin
     Caption := GetCaptionOfKind(Kind);
     ModalResult := BitBtnModalResults[Kind];
@@ -358,6 +362,8 @@ end;
 procedure TCustomBitBtn.Loaded;
 begin
   inherited Loaded;
+  if (Kind <> bkCustom) then
+    RealizeKind(False);
   if (Kind <> bkCustom) and DefaultCaption and (Caption = '') then
   begin
     Caption := GetCaptionOfKind(Kind); // Will trigger TextChanged