ide: rewrite (simplify) High-DPI icon scaling

+ support _150 and _200 variants for component images

git-svn-id: trunk@54946 -

components/ideintf/ideimagesintf.pas

@@ -43,13 +43,16 @@ type
     function GetImages_12: TCustomImageList;
     function GetImages_16: TCustomImageList;
     function GetImages_24: TCustomImageList;
+
+    class function CreateBitmapFromRes(const ImageName: string): TCustomBitmap;
   public
     constructor Create;
     destructor Destroy; override;
 
     class function GetScalePercent: Integer;
-    class function ScaleImage(const AImage: TGraphic; out ANewInstance: Boolean;
+    class function ScaleImage(const AImage: TCustomBitmap; out ANewInstance: Boolean;
-      TargetWidth, TargetHeight: Integer): TGraphic;
+      TargetWidth, TargetHeight: Integer): TCustomBitmap;
+    class function CreateImage(ImageSize: Integer; ImageName: String): TCustomBitmap;
 
     function GetImageIndex(ImageSize: Integer; ImageName: String): Integer;
     function LoadImage(ImageSize: Integer; ImageName: String): Integer;
@@ -112,6 +115,43 @@ begin
     Result := 200; // 200%: 200% scaling
 end;
 
+class function TIDEImages.CreateImage(ImageSize: Integer; ImageName: String
+  ): TCustomBitmap;
+var
+  Grp: TCustomBitmap;
+  GrpScaledNewInstance: Boolean;
+  ScalePercent: Integer;
+begin
+  ScalePercent := GetScalePercent;
+
+  Grp := nil;
+  try
+    if ScalePercent<>100 then
+    begin
+      Grp := CreateBitmapFromRes(ImageName+'_'+IntToStr(ScalePercent));
+      if Grp<>nil then
+      begin
+        Result := Grp;
+        Grp := nil;
+        Exit; // found
+      end;
+    end;
+
+    Grp := CreateBitmapFromRes(ImageName);
+    if Grp<>nil then
+    begin
+      Result := ScaleImage(Grp, GrpScaledNewInstance,
+        ImageSize*ScalePercent div 100, ImageSize * ScalePercent div 100);
+      if not GrpScaledNewInstance then
+        Grp := nil;
+      Exit; // found
+    end;
+  finally
+    Grp.Free;
+  end;
+  Result := nil; // not found
+end;
+
 constructor TIDEImages.Create;
 begin
   FImageNames_12 := TStringList.Create;
@@ -125,6 +165,18 @@ begin
   FImageNames_24.Duplicates := dupIgnore;
 end;
 
+class function TIDEImages.CreateBitmapFromRes(const ImageName: string
+  ): TCustomBitmap;
+var
+  ResHandle: TLResource;
+begin
+  ResHandle := LazarusResources.Find(ImageName);
+  if ResHandle <> nil then
+    Result := CreateBitmapFromLazarusResource(ResHandle)
+  else
+    Result := CreateBitmapFromResourceName(HInstance, ImageName);
+end;
+
 destructor TIDEImages.Destroy;
 begin
   FreeAndNil(FImages_12);
@@ -158,45 +210,10 @@ begin
 end;
 
 function TIDEImages.LoadImage(ImageSize: Integer; ImageName: String): Integer;
-  function _AddBitmap(AList: TCustomImageList; AGrp: TGraphic): Integer;
-  begin
-    if AGrp is TCustomBitmap then
-      Result := AList.Add(TCustomBitmap(AGrp), nil)
-    else
-      Result := AList.AddIcon(AGrp as TCustomIcon);
-  end;
-  function _LoadImage(AList: TCustomImageList): Integer;
-  var
-    Grp, GrpScaled: TGraphic;
-    GrpScaledNewInstance: Boolean;
-    ScalePercent: Integer;
-  begin
-    ScalePercent := GetScalePercent;
-
-    Grp := nil;
-    try
-      if ScalePercent<>100 then
-      begin
-        Grp := CreateGraphicFromResourceName(HInstance, ImageName+'_'+IntToStr(ScalePercent));
-        if Grp<>nil then
-          Exit(_AddBitmap(AList, Grp));
-      end;
-
-      Grp := CreateGraphicFromResourceName(HInstance, ImageName);
-      GrpScaled := ScaleImage(Grp, GrpScaledNewInstance, AList.Width, AList.Height);
-      try
-        Result := _AddBitmap(AList, GrpScaled);
-      finally
-        if GrpScaledNewInstance then
-          GrpScaled.Free;
-      end;
-    finally
-      Grp.Free;
-    end;
-  end;
 var
   List: TCustomImageList;
   Names: TStringList;
+  Grp: TGraphic;
 begin
   Result := GetImageIndex(ImageSize, ImageName);
   if Result <> -1 then Exit;
@@ -221,7 +238,17 @@ begin
     Exit;
   end;
   try
-    Result := _LoadImage(List);
+    Grp := CreateImage(ImageSize, ImageName);
+    try
+      if Grp=nil then
+        raise Exception.CreateFmt('TIDEImages.LoadImage: %s not found.', [ImageName]);
+      if Grp is TCustomBitmap then
+        Result := List.Add(TCustomBitmap(Grp), nil)
+      else
+        Result := List.AddIcon(Grp as TCustomIcon);
+    finally
+      Grp.Free;
+    end;
   except
     on E: Exception do begin
       DebugLn('While loading IDEImages: ' + e.Message);
@@ -231,16 +258,16 @@ begin
   Names.AddObject(ImageName, TObject(PtrInt(Result)));
 end;
 
-class function TIDEImages.ScaleImage(const AImage: TGraphic; out
+class function TIDEImages.ScaleImage(const AImage: TCustomBitmap; out
-  ANewInstance: Boolean; TargetWidth, TargetHeight: Integer): TGraphic;
+  ANewInstance: Boolean; TargetWidth, TargetHeight: Integer): TCustomBitmap;
 var
-  ScalePercent: Integer;
   Bmp: TBitmap;
 begin
-  ANewInstance := False;
+  if (AImage.Width=TargetWidth) and (AImage.Height=TargetHeight) then
-  ScalePercent := GetScalePercent;
+  begin
-  if ScalePercent=100 then
+    ANewInstance := False;
     Exit(AImage);
+  end;
 
   Bmp := TBitmap.Create;
   try
@@ -256,7 +283,7 @@ begin
     Bmp.SetSize(TargetWidth, TargetHeight);
     Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
     Bmp.Canvas.StretchDraw(
-      Rect(0, 0, MulDiv(AImage.Width, ScalePercent, 100), MulDiv(AImage.Height, ScalePercent, 100)),
+      Rect(0, 0, TargetWidth, TargetHeight),
       AImage);
   except
     FreeAndNil(Result);

designer/anchoreditor.pas

@@ -37,7 +37,7 @@ interface
 uses
   Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, StdCtrls, Buttons, Spin,
   ExtCtrls, Graphics, IDECommands, PropEdits, IDEDialogs, LazarusIDEStrConsts,
-  IDEOptionDefs;
+  IDEOptionDefs, IDEImagesIntf;
 
 type
 
@@ -466,30 +466,31 @@ end;
 
 procedure TAnchorDesigner.LoadGlyphs;
 
-  function GetSuffix: String;
+  procedure LoadGlyph(const aBtn: TSpeedButton; const aName: String);
-    begin
+  var
-      if Screen.PixelsPerInch < 144 then Exit('');
+    xBmp: TCustomBitmap;
-      if Screen.PixelsPerInch < 192 then Exit('_150');
+  begin
-      Exit('_200');
+    xBmp := TIDEImages.CreateImage(16, aName);
+    try
+      aBtn.Glyph.Assign(xBmp);
+    finally
+      xBmp.Free;
     end;
+  end;
 
-var
-  Suffix: String;
 begin
-  Suffix:=GetSuffix;
+  LoadGlyph(LeftRefLeftSpeedButton, 'anchor_left_left');
-
+  LoadGlyph(LeftRefCenterSpeedButton, 'anchor_left_center');
-  LeftRefLeftSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_left_left'+Suffix);
+  LoadGlyph(LeftRefRightSpeedButton, 'anchor_left_right');
-  LeftRefCenterSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_left_center'+Suffix);
+  LoadGlyph(RightRefLeftSpeedButton, 'anchor_right_left');
-  LeftRefRightSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_left_right'+Suffix);
+  LoadGlyph(RightRefCenterSpeedButton, 'anchor_right_center');
-  RightRefLeftSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_right_left'+Suffix);
+  LoadGlyph(RightRefRightSpeedButton, 'anchor_right_right');
-  RightRefCenterSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_right_center'+Suffix);
+  LoadGlyph(TopRefTopSpeedButton, 'anchor_top_top');
-  RightRefRightSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_right_right'+Suffix);
+  LoadGlyph(TopRefCenterSpeedButton, 'anchor_top_center');
-  TopRefTopSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_top_top'+Suffix);
+  LoadGlyph(TopRefBottomSpeedButton, 'anchor_top_bottom');
-  TopRefCenterSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_top_center'+Suffix);
+  LoadGlyph(BottomRefTopSpeedButton, 'anchor_bottom_top');
-  TopRefBottomSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_top_bottom'+Suffix);
+  LoadGlyph(BottomRefCenterSpeedButton, 'anchor_bottom_center');
-  BottomRefTopSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_bottom_top'+Suffix);
+  LoadGlyph(BottomRefBottomSpeedButton, 'anchor_bottom_bottom');
-  BottomRefCenterSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_bottom_center'+Suffix);
-  BottomRefBottomSpeedButton.LoadGlyphFromResourceName(HInstance, 'anchor_bottom_bottom'+Suffix);
 end;
 
 procedure TAnchorDesigner.CreateSideControls;

designer/designer.pp

@@ -3541,8 +3541,6 @@ begin
   IconRect := Rect(0, 0, NonVisualCompWidth, NonVisualCompWidth);
   FSurface.Canvas.Frame3D(IconRect, 1, bvRaised);
   FSurface.Canvas.FillRect(IconRect);
-  if NonVisualCompBorder > 1 then
-    InflateRect(IconRect, -NonVisualCompBorder + 1, -NonVisualCompBorder + 1);
 
   // draw component Name
   if ShowComponentCaptions
@@ -3577,7 +3575,9 @@ begin
     FOnGetNonVisualCompIcon(Self, AComponent, Icon);
     if Icon <> nil then
     begin
-      InflateRect(IconRect, -2 * NonVisualCompBorder, -2 * NonVisualCompBorder);
+      InflateRect(IconRect,
+        - (IconRect.Right-IconRect.Left-Icon.Width) div 2,
+        - (IconRect.Bottom-IconRect.Top-Icon.Height) div 2);
       FSurface.Canvas.StretchDraw(IconRect, Icon);
     end;
   end;

designer/designerprocs.pas

@@ -82,7 +82,6 @@ type
   end;
 
 const
-  NonVisualCompIconWidth = ComponentPaletteImageWidth;
   NonVisualCompBorder = 2;
 
 
@@ -350,9 +349,9 @@ end;
 function NonVisualCompWidth: integer;
 begin
   if Application.Scaled then
-    Result := MulDiv(NonVisualCompIconWidth, Screen.PixelsPerInch, 96) + 2 * NonVisualCompBorder
+    Result := MulDiv(ComponentPaletteImageWidth, Screen.PixelsPerInch, 96) + 2 * NonVisualCompBorder
   else
-    Result := NonVisualCompIconWidth + 2 * NonVisualCompBorder
+    Result := ComponentPaletteImageWidth + 2 * NonVisualCompBorder
 end;
 
 function GetParentLevel(AControl: TControl): integer;

ide/componentlist.pas

@@ -323,8 +323,6 @@ var
   ClssName: string;
   i, Ind: Integer;
   CurIcon: TCustomBitmap;
-  ScaledIcon: TGraphic;
-  NewScaledIcon: Boolean;
 begin
   PalList := TStringList.Create;
   try
@@ -359,14 +357,8 @@ begin
             CurIcon := nil;
           if Assigned(CurIcon) then
           begin
-            ScaledIcon := TIDEImages.ScaleImage(CurIcon, NewScaledIcon, imInheritance.Width, imInheritance.Height);
+            Node.ImageIndex := imInheritance.Add(CurIcon, nil);
-            try
+            Node.SelectedIndex := Node.ImageIndex;
-              Node.ImageIndex := imInheritance.Add(ScaledIcon as TCustomBitmap, nil);
-              Node.SelectedIndex := Node.ImageIndex;
-            finally
-              if NewScaledIcon then
-                ScaledIcon.Free;
-            end;
           end;
         end;
         FClassList.AddObject(ClssName, Node);
@@ -388,8 +380,6 @@ var
   APaletteNode: TTreeNode;
   i, j: Integer;
   CurIcon: TCustomBitmap;
-  NewScaledIcon: Boolean;
-  ScaledIcon: TGraphic;
 begin
   if [csDestroying,csLoading]*ComponentState<>[] then exit;
   Screen.Cursor := crHourGlass;
@@ -426,16 +416,10 @@ begin
           CurIcon := nil;
         if Assigned(CurIcon) then
         begin
-          ScaledIcon := TIDEImages.ScaleImage(CurIcon, NewScaledIcon, imListPalette.Width, imListPalette.Height);
+          AListNode.ImageIndex := imListPalette.Add(CurIcon, nil);
-          try
+          AListNode.SelectedIndex := AListNode.ImageIndex;
-            AListNode.ImageIndex := imListPalette.Add(ScaledIcon as TCustomBitmap, nil);
+          APaletteNode.ImageIndex := AListNode.ImageIndex;
-            AListNode.SelectedIndex := AListNode.ImageIndex;
+          APaletteNode.SelectedIndex := AListNode.ImageIndex;
-            APaletteNode.ImageIndex := AListNode.ImageIndex;
-            APaletteNode.SelectedIndex := AListNode.ImageIndex;
-          finally
-            if NewScaledIcon then
-              ScaledIcon.Free;
-          end;
         end;
         // Component inheritence item
         DoComponentInheritence(Comp);

ide/componentpalette.pas

@@ -40,7 +40,7 @@ interface
 uses
   Classes, SysUtils, fgl, Laz_AVL_Tree,
   // LCL
-  LCLType, LCLProc, Controls, Forms, Graphics, ComCtrls, Buttons, Menus, ExtCtrls,
+  LCLProc, Controls, Forms, Graphics, ComCtrls, Buttons, Menus, ExtCtrls,
   // LazUtils
   LazFileUtils, LazFileCache,
   // IdeIntf
@@ -426,8 +426,6 @@ var
   Btn: TSpeedButton;
   CompCN: String;      // Component ClassName
   i: Integer;
-  ScaledIcon: TGraphic;
-  NewScaledIcon: Boolean;
 begin
   Pal := TComponentPalette(Palette);
   CompCN := aComp.ComponentClass.ClassName;
@@ -445,15 +443,7 @@ begin
       Btn.Name := CompPaletteCompBtnPrefix + aButtonUniqueName + CompCN;
       // Left and Top will be set in ReAlignButtons.
       Btn.SetBounds(Btn.Left,Btn.Top,aScrollBox.ScaleCoord(ComponentPaletteBtnWidth),aScrollBox.ScaleCoord(ComponentPaletteBtnHeight));
-      ScaledIcon := TIDEImages.ScaleImage(aComp.Icon, NewScaledIcon,
+      Btn.Glyph.Assign(aComp.Icon);
-        MulDiv(ComponentPaletteImageWidth, TIDEImages.GetScalePercent, 100),
-        MulDiv(ComponentPaletteImageWidth, TIDEImages.GetScalePercent, 100));
-      try
-        Btn.Glyph.Assign(ScaledIcon);
-      finally
-        if NewScaledIcon then
-          ScaledIcon.Free;
-      end;
       Btn.GroupIndex := 1;
       Btn.Flat := true;
       Btn.OnMouseDown := @Pal.ComponentBtnMouseDown;

packager/packagedefs.pas

@@ -47,7 +47,7 @@ uses
   LazFileUtils, LazFileCache, LazUTF8, AvgLvlTree,
   // IDEIntf
   PropEdits, LazIDEIntf, MacroIntf, MacroDefIntf, IDEOptionsIntf,
-  PackageDependencyIntf, PackageIntf, IDEDialogs, ComponentReg,
+  PackageDependencyIntf, PackageIntf, IDEDialogs, ComponentReg, IDEImagesIntf,
   // IDE
   EditDefineTree, CompilerOptions, CompOptsModes, IDEOptionDefs, ProjPackCommon,
   LazarusIDEStrConsts, IDEProcs, TransferMacros, FileReferenceList, PublishModule;
@@ -4016,16 +4016,10 @@ end;
 
 function TPkgComponent.GetIconCopy: TCustomBitMap;
 var
-  ResHandle: TLResource;
   ResName: String;
 begin
   ResName := ComponentClass.ClassName;
-  // prevent raising exception and speedup a bit search/load
+  Result := TIDEImages.CreateImage(24, ResName);
-  ResHandle := LazarusResources.Find(ResName);
-  if ResHandle <> nil then
-    Result := CreateBitmapFromLazarusResource(ResHandle)
-  else
-    Result := CreateBitmapFromResourceName(HInstance, ResName);
 
   if Result = nil then
     Result := CreateBitmapFromResourceName(HInstance, 'default')