paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 16:25:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TLCLGlyphs: fix loading images. Issue #33826

Browse Source 
git-svn-id: trunk@58131 -
This commit is contained in:
ondrej 2018-06-05 07:31:39 +00:00
parent c560db1304
commit 8c5aa34fba
2 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/imglist.pp
View File

@ -298,6 +298,7 @@ type
const ACanvasScaleFactor: Double): TScaledImageListResolution;
function GetWidthForPPI(AImageWidth, APPI: Integer): Integer;
function GetHeightForPPI(AImageWidth, APPI: Integer): Integer;
function GetHeightForWidth(AWidth: Integer): Integer;
function GetCount: Integer;
function GetSizeForPPI(AImageWidth, APPI: Integer): TSize;
function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer; // the icon must be sorted
@ -400,6 +401,7 @@ type
property DrawingStyle: TDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal;
property Height: Integer read FHeight write SetHeight default 16;
property HeightForPPI[AImageWidth, APPI: Integer]: Integer read GetHeightForPPI;
property HeightForWidth[AWidth: Integer]: Integer read GetHeightForWidth;
property Width: Integer read FWidth write SetWidth default 16;
property WidthForPPI[AImageWidth, APPI: Integer]: Integer read GetWidthForPPI;
property SizeForPPI[AImageWidth, APPI: Integer]: TSize read GetSizeForPPI;

22
lcl/include/imglist.inc
View File

@ -1183,7 +1183,7 @@ begin
Result.FImageList := FImageList;
Result.FWidth := AImageWidth;
if FImageList.Width<>0 then
Result.FHeight := FImageList.Height * AImageWidth div FImageList.Width
Result.FHeight := FImageList.GetHeightForWidth(AImageWidth)
else
Result.FHeight := 0;
Result.FAutoCreatedInDesignTime := AutoCreatedInDesignTime and (AImageWidth<>FImageList.Width);
@ -1804,12 +1804,15 @@ begin
if FData.Find(AImageWidth, I) then
Result := FData[I].Height
else
begin
if FWidth<>0 then
Result := AImageWidth * FHeight div FWidth
else
Result := 0;
end;
Result := GetHeightForWidth(AImageWidth)
end;
function TCustomImageList.GetHeightForWidth(AWidth: Integer): Integer;
begin
if FWidth<>0 then
Result := AWidth * FHeight div FWidth
else
Result := 0;
end;
procedure TCustomImageList.GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect);
@ -2724,12 +2727,15 @@ function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
function AddNewBtnImage(Resolution: TResolution): Integer;
var
G: TCustomBitmap;
ImageRect: TRect;
begin
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, True);
if G=nil then
Exit(-1);
try
Result := AddSliceCentered(G);
ImageRect := Rect(0, 0, Resolution.Width, GetHeightForWidth(Resolution.Width));
OffsetRect(ImageRect, (G.Width-ImageRect.Right) div 2, (G.Height-ImageRect.Bottom) div 2);
Result := AddSlice(G, ImageRect);
finally
G.Free;
end;