scale top toolbar

lazpaint/lazpaintmainform.pas

@@ -885,7 +885,7 @@ begin
   FLayout.OnPictureMouseMove:=@PictureMouseMove;
   FLayout.OnPictureMouseBefore:=@PictureMouseBefore;
 
-  ScaleControl(Self,OriginalDPI);
+  //ScaleControl(Self,OriginalDPI);
   self.Color := clBtnFace; //toolbar color inherited on mac
 
   //mac interface
@@ -1118,6 +1118,8 @@ procedure TFMain.FormShow(Sender: TObject);
 var
   m: TMainFormMenu;
   startFillControlWidth: LongInt;
+  iconSize: Integer;
+  toolbarDPI: integer;
 begin
   if FLayout.Menu = nil then
   begin
@@ -1131,7 +1133,12 @@ begin
       Panel_CloseShape,Panel_LineCap,Panel_Aliasing,
       Panel_SplineStyle,Panel_Eraser,Panel_Tolerance,Panel_Text,Panel_Altitude,Panel_TextShadow,Panel_TextOutline,
       Panel_OutlineFill,Panel_PhongShape,Panel_PerspectiveOption,Panel_Brush,Panel_Ratio,Panel_Donate],Panel_ToolbarBackground);
-    m.ImageList := LazPaintInstance.Icons[ScaleY(16, 96)];
+    iconSize := round(Config.DefaultIconSize(ScaleY(16, 96)) * 16 / 20);
+    if iconSize < 16 then iconSize := 16;
+    toolbarDPI := round(96*iconSize/16);
+    m.ScaleToolbars(toolbarDPI);
+    ScaleControl(Panel_PenWidthPreview, OriginalDPI, toolbarDPI, toolbarDPI);
+    m.ImageList := LazPaintInstance.Icons[iconSize];
     m.Apply;
     FLayout.Menu := m;
 

lazpaint/umenu.pas

@@ -33,6 +33,7 @@ type
   protected
     FInstance: TLazPaintCustomInstance;
     FInstalledScripts: TStringList;
+    FTargetDPI: integer;
     procedure AddMenus(AMenu: TMenuItem; AActionList: TActionList; AActionsCommaText: string; AIndex: integer = -1); overload;
     procedure AddMenus(AMenuName: string; AActionsCommaText: string); overload;
     procedure AddInstalledScripts(AMenu: TMenuItem; AIndex: integer = -1);
@@ -45,6 +46,7 @@ type
     destructor Destroy; override;
     procedure PredefinedMainMenus(const AMainMenus: array of TMenuItem);
     procedure Toolbars(const AToolbars: array of TPanel; AToolbarBackground: TPanel);
+    procedure ScaleToolbars(ATargetDPI: integer);
     procedure CycleTool(var ATool: TPaintToolType; var AShortCut: TUTF8Char);
     procedure Apply;
     procedure ArrangeToolbars(ClientWidth: integer);
@@ -185,6 +187,7 @@ begin
           item.Caption := rsIconSize;
           item.OnClick:=@IconSizeMenuClick;
           AddSubItem('16px', @IconSizeItemClick, 16);
+          AddSubItem('20px', @IconSizeItemClick, 20);
           AddSubItem('24px', @IconSizeItemClick, 24);
           AddSubItem('32px', @IconSizeItemClick, 32);
           AddSubItem('40px', @IconSizeItemClick, 40);
@@ -364,7 +367,7 @@ end;
 
 function TMainFormMenu.GetIndividualToolbarHeight: integer;
 begin
-  result := DoScaleY(26,OriginalDPI);
+  result := DoScaleY(24,OriginalDPI,FTargetDPI);
 end;
 
 constructor TMainFormMenu.Create(AInstance: TLazPaintCustomInstance; AActionList: TActionList);
@@ -372,6 +375,7 @@ begin
   FInstance := AInstance;
   FActionList := AActionList;
   FToolbarsHeight := 0;
+  FTargetDPI := OriginalDPI;
 end;
 
 destructor TMainFormMenu.Destroy;
@@ -412,6 +416,15 @@ begin
   FToolbarBackground := AToolbarBackground;
 end;
 
+procedure TMainFormMenu.ScaleToolbars(ATargetDPI: integer);
+var
+  i: Integer;
+begin
+  FTargetDPI := ATargetDPI;
+  for i := 0 to high(FToolbars) do
+    ScaleControl(FToolbars[i].tb, OriginalDPI, ATargetDPI, ATargetDPI, true);
+end;
+
 procedure TMainFormMenu.CycleTool(var ATool: TPaintToolType;
   var AShortCut: TUTF8Char);
 var
@@ -516,7 +529,7 @@ begin
      begin
        for j := 0 to tb.ControlCount-1 do
        begin
-         tb.Controls[j].Top := 1;
+         tb.Controls[j].Top := DoScaleY(1, OriginalDPI, FTargetDPI);
          if tb.Controls[j] is TLCVectorialFillControl then
          begin
            vfc := TLCVectorialFillControl(tb.Controls[j]);

lazpaintcontrols/lcscaledpi.pas

@@ -105,8 +105,8 @@ begin
     Result := Size * ToDPI / FromDPI;
 end;
 
-procedure ScaleControl(Control: TControl; FromDPI: Integer; ToDPI_X: Integer; ToDPI_Y: integer;
-  ScaleToolbar: boolean = false);
+procedure ScaleControl(Control: TControl; FromDPI: Integer; ToDPI_X: Integer;
+  ToDPI_Y: Integer; ScaleToolbar: boolean);
 var
   n: Integer;
   WinControl: TWinControl;
@@ -123,11 +123,12 @@ begin
     Top:=DoScaleY(Top,FromDPI,ToDPI_Y);
     Width:=DoScaleX(Width,FromDPI,ToDPI_X);
     Height:=DoScaleY(Height,FromDPI,ToDPI_Y);
-    {$IFDEF LCL Qt}
-      Font.Size := 0;
-    {$ELSE}
-      Font.Height := ScaleY(Font.GetTextHeight('Hg'),FromDPI);
-    {$ENDIF}
+    if Font.Size = 0 then
+    begin
+      if ToDPI_Y <> Screen.PixelsPerInch then
+        Font.Height := DoScaleY(Font.GetTextHeight('Hg'),FromDPI,ToDPI_Y);
+    end else
+      Font.Size:= round(Font.Size * ToDPI_Y / Screen.PixelsPerInch);
   end;
 
   if Control is TToolBar then begin

lazpaintcontrols/lctoolbars.pas

@@ -27,7 +27,7 @@ procedure LoadToolbarImage(AImages: TImageList; AIndex: integer; AFilename: stri
 
 implementation
 
-uses BGRALazPaint, BGRABitmap, BGRABitmapTypes, math, Toolwin;
+uses BGRALazPaint, Graphics, BGRABitmap, BGRABitmapTypes, math, Toolwin;
 
 function CreateToolBar(AImages: TImageList; AOwner: TComponent): TToolbar;
 begin
@@ -115,19 +115,33 @@ end;
 procedure LoadToolbarImage(AImages: TImageList; AIndex: integer; AFilename: string);
 var
   iconImg: TBGRALazPaintImage;
-  iconFlat: TBGRABitmap;
+  iconFlat: array of TBGRABitmap;
+  bmpArray: array of TCustomBitmap;
+  i: Integer;
 begin
   iconImg := TBGRALazPaintImage.Create;
   iconImg.LoadFromResource(AFilename);
-  iconImg.Resample(AImages.Width,AImages.Height,rmFineResample,rfBestQuality);
-  iconFlat := TBGRABitmap.Create(iconImg.Width,iconImg.Height);
-  iconImg.Draw(iconFlat,0,0);
+  setlength(iconFlat, AImages.ResolutionCount);
+  setlength(bmpArray, length(iconFlat));
+  for i := 0 to high(iconFlat) do
+  begin
+    iconImg.Resample(AImages.ResolutionByIndex[i].Width,
+                      AImages.ResolutionByIndex[i].Height,
+                      rmFineResample,rfBestQuality);
+    iconFlat[i] := TBGRABitmap.Create(iconImg.Width, iconImg.Height);
+    iconImg.Draw(iconFlat[i],0,0);
+    bmpArray[i] := iconFlat[i].Bitmap;
+  end;
+  iconImg.Free;
   if AImages.Count < AIndex then
-    AImages.Replace(AIndex, iconFlat.Bitmap,nil)
+  begin
+    for i := 0 to high(iconFlat) do
+      AImages.Replace(AIndex, bmpArray[i],nil, false);
+  end
   else
-    AImages.Add(iconFlat.Bitmap,nil);
-  iconFlat.Free;
-  iconImg.Free;
+    AImages.AddMultipleResolutions(bmpArray);
+  for i := 0 to high(iconFlat) do
+    iconFlat[i].Free;
 end;
 
 function AddToolbarLabel(AToolbar: TToolbar; ACaption: string;

lazpaintcontrols/lcvectorialfillinterface.pas

@@ -270,6 +270,10 @@ begin
   FImageList.Clear;
   FImageList.Width := FImageListSize.cx;
   FImageList.Height := FImageListSize.cy;
+  {$IFDEF DARWIN}
+  FImageList.Scaled := true;
+  FImageList.RegisterResolutions([FImageListSize.cx, FImageListSize.cx*2]);
+  {$ENDIF}
 
   lst := TStringList.Create;
   lst.CommaText := GetResourceString('fillimages.lst');