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

lcl: TLCLGlyphs: fix rounding error when calculating suffixes

Browse Source 
git-svn-id: trunk@57864 -
This commit is contained in:
ondrej 2018-05-09 01:36:25 +00:00
parent cb0d5d86d4
commit 26213f037c
3 changed files with 42 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/grids.pas
View File

@ -5432,7 +5432,7 @@ begin
FSortLCLImages.Width := 8;
FSortLCLImages.Height := 8;
FSortLCLImages.RegisterResolutions([8, 12, 16]);
FSortLCLImages.Suffix100Scale := 16;
FSortLCLImages.SetWidth100Suffix(16);
end;
ImgList := FSortLCLImages;
case FSortOrder of

12
lcl/imglist.pp
View File

@ -432,22 +432,26 @@ type
// value
ImageIndex: Integer; // the image index in TLCLGlyphs
end;
TResolution = record
Width: Integer;
ScaleSuffix: Integer;
end;
private
FIgnoreMissingResources: Boolean;
FImageIndexes: TAvgLvlTree;
FLoadResolutions: array of Integer;
FLoadResolutions: array of TResolution;
FSuffix100Scale: Integer;
function RealSuffix100Scale: Integer;
public
function GetImageIndex(const AResourceName: string): Integer;
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 Suffix100Scale: Integer read FSuffix100Scale write FSuffix100Scale;
end;
function LCLGlyphs: TLCLGlyphs;

46
lcl/include/imglist.inc
View File

@ -2729,11 +2729,11 @@ end;
function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
function AddNewBtnImage(ResolutionWidth: Integer): Integer;
function AddNewBtnImage(Resolution: TResolution): Integer;
var
G: TCustomBitmap;
begin
G := GetDefaultGlyph(AResourceName, MulDiv(ResolutionWidth, 100, RealSuffix100Scale), FIgnoreMissingResources);
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, FIgnoreMissingResources);
if G=nil then
Exit(-1);
try
@ -2743,14 +2743,14 @@ function TLCLGlyphs.GetImageIndex(const AResourceName: string): Integer;
end;
end;
procedure AddBtnImageRes(ImageIndex, ResolutionWidth: Integer);
procedure AddBtnImageRes(ImageIndex: Integer; Resolution: TResolution);
var
G: TCustomBitmap;
begin
G := GetDefaultGlyph(AResourceName, MulDiv(ResolutionWidth, 100, RealSuffix100Scale), FIgnoreMissingResources);
G := GetDefaultGlyph(AResourceName, Resolution.ScaleSuffix, FIgnoreMissingResources);
if G<>nil then
try
ReplaceSliceCentered(ImageIndex, ResolutionWidth, G, False);
ReplaceSliceCentered(ImageIndex, Resolution.Width, G, False);
finally
G.Free;
end;
@ -2771,22 +2771,31 @@ begin
begin
E := TEntry.Create;
E.GlyphName := AResourceName;
E.ImageIndex := AddNewBtnImage(Width);
E.ImageIndex := -1;
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
if FLoadResolutions[I].Width=Width then
begin
E.ImageIndex := AddNewBtnImage(FLoadResolutions[I]);
break;
end;
if E.ImageIndex>=0 then
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
if FLoadResolutions[I]<>Width then
if FLoadResolutions[I].Width<>Width then
AddBtnImageRes(E.ImageIndex, FLoadResolutions[I]);
FImageIndexes.Add(E);
Result := E.ImageIndex;
end;
end;
function TLCLGlyphs.RealSuffix100Scale: Integer;
procedure TLCLGlyphs.RegisterResolutions(const AResolutionWidths,
AResolutionScaleSuffixes: array of Integer);
var
I: Integer;
begin
if FSuffix100Scale=0 then
Result := Width
else
Result := FSuffix100Scale;
RegisterResolutions(AResolutionWidths);
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
FLoadResolutions[I].ScaleSuffix := AResolutionScaleSuffixes[I];
end;
procedure TLCLGlyphs.RegisterResolutions(
@ -2798,7 +2807,18 @@ begin
SetLength(FLoadResolutions, Length(AResolutionWidths));
for I := Low(FLoadResolutions) to High(FLoadResolutions) do
FLoadResolutions[I] := AResolutionWidths[I];
begin
FLoadResolutions[I].Width := AResolutionWidths[I];
FLoadResolutions[I].ScaleSuffix := MulDiv(FLoadResolutions[I].Width, 100, Width);
end;
end;
procedure TLCLGlyphs.SetWidth100Suffix(const AWidth100Suffix: Integer);
var
I: Integer;
begin
for I := 0 to High(FLoadResolutions) do
FLoadResolutions[I].ScaleSuffix := MulDiv(FLoadResolutions[I].Width, 100, AWidth100Suffix);
end;
procedure InterfaceFinal;