paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 21:38:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TLCLGlyphs: more options for missing resources. Use gmrOneMustExist as default.

Browse Source 
git-svn-id: trunk@58106 -
This commit is contained in:
ondrej 2018-06-04 00:55:11 +00:00
parent 6052652ec3
commit 50dc18646e
2 changed files with 38 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lcl/imglist.pp
View File

@ -419,6 +419,11 @@ type
property OnGetWidthForPPI: TCustomImageListGetWidthForPPI read FOnGetWidthForPPI write FOnGetWidthForPPI;
end;
TLCLGlyphsMissingResources = (
gmrAllMustExist, // Show exception if any image/resolution is not found
gmrOneMustExist, // Show exception if no resolution is found. Missing resolutions will be auto-generated from the biggest one.
gmrIgnoreAll); // Ignore all missing resources. No image will be added if no resolution is found.
TLCLGlyphs = class(TCustomImageList)
private type
TEntryKey = record
@ -440,20 +445,23 @@ type
end;
private
FIgnoreMissingResources: Boolean;
FMissingResources: TLCLGlyphsMissingResources;
FImageIndexes: TAvgLvlTree;
FLoadResolutions: array of TResolution;
FSuffix100Scale: Integer;
public
function GetImageIndex(const AResourceName: string): Integer;
// AResolutionWidths must be sorted from smallest to biggest
procedure RegisterResolutions(const AResolutionWidths: array of Integer); override;
procedure RegisterResolutions(const AResolutionWidths, AResolutionScaleSuffixes: array of Integer); overload;
procedure SetWidth100Suffix(const AWidth100Suffix: Integer);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property IgnoreMissingResources: Boolean read FIgnoreMissingResources write FIgnoreMissingResources;
property MissingResources: TLCLGlyphsMissingResources read FMissingResources write FMissingResources;
end;
function LCLGlyphs: TLCLGlyphs;

44
lcl/include/imglist.inc
View File

@ -2701,7 +2701,7 @@ begin
FImageIndexes := TAvgLvlTree.Create(@TLCLGlyphs_TEntry_Compare);
Scaled := True;
FIgnoreMissingResources := True;
FMissingResources := gmrOneMustExist;
end;
destructor TLCLGlyphs.Destroy;
@ -2718,7 +2718,7 @@ function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
var
G: TCustomBitmap;
begin
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, FIgnoreMissingResources);
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, True);
if G=nil then
Exit(-1);
try
@ -2732,7 +2732,7 @@ function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
var
G: TCustomBitmap;
begin
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, FIgnoreMissingResources);
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, FMissingResources in [gmrIgnoreAll, gmrOneMustExist]);
if G<>nil then
try
ReplaceSliceCentered(ImageIndex, Resolution.Width, G, False);
@ -2745,7 +2745,7 @@ var
K: TEntryKey;
ANode: TAVLTreeNode;
E: TEntry;
I: Integer;
I, FirstLoadedResolutionI: Integer;
begin
K.GlyphName := AResourceName;
@ -2754,21 +2754,29 @@ begin
Result := TEntry(ANode.Data).ImageIndex
else
begin
E := TEntry.Create;
E.GlyphName := AResourceName;
E.ImageIndex := -1;
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
if FLoadResolutions[I].Width=Width then
Result := -1;
FirstLoadedResolutionI := Low(FLoadResolutions)-1;
for I := High(FLoadResolutions) downto Low(FLoadResolutions) do // start with the biggest one
begin
Result := AddNewBtnImage(FLoadResolutions[I]);
if Result>=0 then
begin
E.ImageIndex := AddNewBtnImage(FLoadResolutions[I]);
FirstLoadedResolutionI := I;
break;
end;
if E.ImageIndex>=0 then
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
if FLoadResolutions[I].Width<>Width then
AddBtnImageRes(E.ImageIndex, FLoadResolutions[I]);
end;
if (Result>=0) and (FirstLoadedResolutionI>=Low(FLoadResolutions)) then
begin
for I := FirstLoadedResolutionI-1 downto Low(FLoadResolutions) do // load the smaller ones
AddBtnImageRes(Result, FLoadResolutions[I]);
end else
if FMissingResources in [gmrAllMustExist, gmrOneMustExist] then
raise EResNotFound.CreateFmt(SResNotFound,[AResourceName]);
E := TEntry.Create;
FImageIndexes.Add(E);
Result := E.ImageIndex;
E.GlyphName := AResourceName;
E.ImageIndex := Result;
end;
end;
@ -2786,13 +2794,17 @@ end;
procedure TLCLGlyphs.RegisterResolutions(
const AResolutionWidths: array of Integer);
var
I: Integer;
I, LastWidth: Integer;
begin
inherited RegisterResolutions(AResolutionWidths);
SetLength(FLoadResolutions, Length(AResolutionWidths));
LastWidth := 0;
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
begin
if AResolutionWidths[I]<=LastWidth then
raise Exception.Create('AResolutionWidths not sorted.');
LastWidth := AResolutionWidths[I];
FLoadResolutions[I].Width := AResolutionWidths[I];
FLoadResolutions[I].ScaleSuffix := MulDiv(FLoadResolutions[I].Width, 100, Width);
end;