paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 09:17:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: LCLGlyphs: fix loading images

Browse Source 
git-svn-id: trunk@57851 -
This commit is contained in:
ondrej 2018-05-08 21:39:58 +00:00
parent 5d6c224676
commit 7932ab234f
2 changed files with 30 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/imglist.pp
View File

@ -447,7 +447,8 @@ type
end;
function LCLGlyphs: TLCLGlyphs;
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100): TCustomBitmap;
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100;
IgnoreMissingResource: Boolean = False): TCustomBitmap;
implementation

46
lcl/include/imglist.inc
View File

@ -42,12 +42,19 @@ begin
Result := GLCLGlyphs;
end;
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100): TCustomBitmap;
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer;
IgnoreMissingResource: Boolean): TCustomBitmap;
begin
Result := TPortableNetworkGraphic.Create;
if ScalePercent<>100 then
ResourceName := ResourceName+'_'+IntToStr(ScalePercent);
Result.LoadFromResourceName(hInstance, ResourceName);
Result := TPortableNetworkGraphic.Create;
if IgnoreMissingResource
and (FindResource(HInstance, PChar(ResourceName), Result.GetResourceType)=0) then
begin
FreeAndNil(Result);
Exit;
end else
Result.LoadFromResourceName(hInstance, ResourceName);
end;
{------------------------------------------------------------------------------
@ -2726,28 +2733,31 @@ end;
function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
function AddBtnImage(ResolutionWidth: Integer): Integer;
function AddNewBtnImage(ResolutionWidth: Integer): Integer;
var
G: TCustomBitmap;
begin
if FIgnoreMissingResources and (ResolutionWidth<>Width)
and (FindResource(HInstance, PChar(AResourceName), RT_RCDATA)=0) then
Exit;
G := GetDefaultGlyph(AResourceName, MulDiv(ResolutionWidth, 100, 16));
G := GetDefaultGlyph(AResourceName, MulDiv(ResolutionWidth, 100, 16), False);
try
if ResolutionWidth=Width then
Result := AddSliceCentered(G)
else
begin
Result := Count-1;
ReplaceSliceCentered(Result, ResolutionWidth, G, False);
end;
Result := AddSliceCentered(G);
finally
G.Free;
end;
end;
procedure AddBtnImageRes(ImageIndex, ResolutionWidth: Integer);
var
G: TCustomBitmap;
begin
G := GetDefaultGlyph(AResourceName, MulDiv(ResolutionWidth, 100, 16), FIgnoreMissingResources);
if G<>nil then
try
ReplaceSliceCentered(ImageIndex, ResolutionWidth, G, False);
finally
G.Free;
end;
end;
var
K: TEntryKey;
ANode: TAVLTreeNode;
@ -2763,10 +2773,10 @@ begin
begin
E := TEntry.Create;
E.GlyphName := AResourceName;
E.ImageIndex := AddBtnImage(Width);
E.ImageIndex := AddNewBtnImage(Width);
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
if FLoadResolutions[I]<>Width then
AddBtnImage(FLoadResolutions[I]);
AddBtnImageRes(E.ImageIndex, FLoadResolutions[I]);
FImageIndexes.Add(E);
Result := E.ImageIndex;
end;