paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 13:59:10 +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; end;
function LCLGlyphs: TLCLGlyphs; function LCLGlyphs: TLCLGlyphs;
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100): TCustomBitmap; function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100;
IgnoreMissingResource: Boolean = False): TCustomBitmap;
implementation implementation

46
lcl/include/imglist.inc
View File

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