paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 19:40:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: High-DPI: scale open file drop down menu icons.

Browse Source 
git-svn-id: branches/fixes_1_8@55687 -
This commit is contained in:
mattias 2017-08-19 08:39:54 +00:00
parent fce13d6094
commit deb046446d
5 changed files with 42 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/ideintf/ideimagesintf.pas
View File

@ -51,7 +51,7 @@ type
destructor Destroy; override;
class function GetScalePercent: Integer;
class function ScaleImage(const AImage: TCustomBitmap; out ANewInstance: Boolean;
class function ScaleImage(const AImage: TGraphic; out ANewInstance: Boolean;
TargetWidth, TargetHeight: Integer; const AFactor: Double): TCustomBitmap;
class function CreateImage(ImageSize: Integer; ImageName: String): TCustomBitmap; deprecated 'Use the other overload instead.';
class function CreateImage(ImageName: String; ImageSize: Integer = 16): TCustomBitmap;
@ -317,17 +317,17 @@ begin
Names.AddObject(ImageName, TObject(PtrInt(Result)));
end;
class function TIDEImages.ScaleImage(const AImage: TCustomBitmap; out
class function TIDEImages.ScaleImage(const AImage: TGraphic; out
ANewInstance: Boolean; TargetWidth, TargetHeight: Integer;
const AFactor: Double): TCustomBitmap;
var
Bmp: TBitmap;
TargetRect: TRect;
begin
if SameValue(AFactor, 1) then
if SameValue(AFactor, 1) and (AImage is TCustomBitmap) then
begin
ANewInstance := False;
Exit(AImage);
Exit(TCustomBitmap(AImage));
end;
Bmp := TBitmap.Create;

27
components/ideintf/projectintf.pas
View File

@ -17,8 +17,8 @@ interface
uses
Classes, SysUtils, FileUtil, LazFileUtils, Controls, Forms, AvgLvlTree,
NewItemIntf, ProjPackIntf, CompOptsIntf, ObjInspStrConsts, LazFileCache,
LazMethodList, ImgList, Graphics;
NewItemIntf, ProjPackIntf, CompOptsIntf, ObjInspStrConsts, IDEImagesIntf,
LazFileCache, LazMethodList, ImgList, Graphics;
const
FileDescGroupName = 'File';
@ -713,8 +713,10 @@ function LoadProjectIconIntoImages(const ProjFile: string;
var
xIconFile: String;
xIcon: TIcon;
I: Integer;
I, xAlternativeIcon: Integer;
xObj: TLoadProjectIconIntoImagesObject;
xScaledIcon: TCustomBitmap;
xNewIcon: Boolean;
begin
//ToDo: better index
@ -737,6 +739,10 @@ begin
xIcon := TIcon.Create;
try
xIcon.LoadFromFile(xIconFile);
if xIcon.Count>0 then
xAlternativeIcon := 0
else
xAlternativeIcon := -1;
for I := 0 to xIcon.Count-1 do
begin
xIcon.Current := I;
@ -746,6 +752,21 @@ begin
Result := Images.AddIcon(xIcon);
Break;
end;
if (xIcon.Width = 16)
and(xIcon.Height = 16) then
xAlternativeIcon := I;
end;
if (Result<0) and (xAlternativeIcon>=0) then
begin
xIcon.Current := xAlternativeIcon;
xScaledIcon := TIDEImages.ScaleImage(xIcon, xNewIcon, Images.Width, Images.Height, Images.Width/xIcon.Width);
try
Result := Images.Add(xScaledIcon, nil);
finally
if xNewIcon then
xScaledIcon.Free;
end;
end;
finally
xIcon.Free;

4
ide/mainbase.pas
View File

@ -508,8 +508,8 @@ begin
DropdownMenu := TPopupMenu.Create(Self);
DropdownMenu.OnPopup := @RefreshMenu;
DropdownMenu.Images := TCustomImageList.Create(Self);
DropdownMenu.Images.Width := 16;
DropdownMenu.Images.Height := 16;
DropdownMenu.Images.Width := Scale96ToScreen(16);
DropdownMenu.Images.Height := Scale96ToScreen(16);
Style := tbsDropDown;
end;

2
lcl/controls.pp
View File

@ -1493,6 +1493,8 @@ type
function ScaleFontTo96(const ASize: Integer): Integer;
function ScaleScreenToFont(const ASize: Integer): Integer;
function ScaleFontToScreen(const ASize: Integer): Integer;
function Scale96ToScreen(const ASize: Integer): Integer;
function ScaleScreenTo96(const ASize: Integer): Integer;
public
// size
procedure AdjustSize; virtual;// smart calling DoAutoSize

10
lcl/include/control.inc
View File

@ -781,6 +781,11 @@ begin
Result := MulDiv(ASize, ParentForm.PixelsPerInch, 96);
end;
function TControl.Scale96ToScreen(const ASize: Integer): Integer;
begin
Result := MulDiv(ASize, Screen.PixelsPerInch, 96);
end;
function TControl.ScaleFormTo96(const ASize: Integer): Integer;
var
ParentForm: TCustomDesignControl;
@ -797,6 +802,11 @@ begin
Result := MulDiv(ASize, ParentForm.DesignTimePPI, ParentForm.PixelsPerInch);
end;
function TControl.ScaleScreenTo96(const ASize: Integer): Integer;
begin
Result := MulDiv(ASize, 96, Screen.PixelsPerInch);
end;
function TControl.Scale96ToFont(const ASize: Integer): Integer;
begin
Result := MulDiv(ASize, Font.PixelsPerInch, 96);