mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-04 19:40:20 +02:00
LCL: High-DPI ImageList: imglist fixes
git-svn-id: branches/HiDPIImageList@57054 -
This commit is contained in:
ondrej
parent
ba1c5e5fd4
commit
ad9612efd5
@ -122,7 +122,7 @@ type
|
||||
function Add(Image, Mask: TCustomBitmap): Integer;
|
||||
procedure InternalInsert(AIndex: Integer; AData: PRGBAQuad); overload;
|
||||
procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean);
|
||||
procedure InternalReplace(AIndex: Integer; AImage, AMask: HBitmap);
|
||||
procedure InternalReplace(AIndex: Integer; AData: PRGBAQuad);
|
||||
function InternalSetData(AIndex: Integer; AData: PRGBAQuad): PRGBAQuad;
|
||||
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
|
||||
|
||||
@ -190,6 +190,8 @@ type
|
||||
destructor Destroy; override;
|
||||
public
|
||||
function FindBestToScaleFrom(const ATargetWidth: Integer): Integer;
|
||||
procedure Delete(const AIndex: Integer);
|
||||
procedure Clear;
|
||||
|
||||
property ImageLists[const AImageWidth: Integer]: TCustomImageListResolution read GetImageLists;
|
||||
property Items[const AIndex: Integer]: TCustomImageListResolution read GetItems; default;
|
||||
@ -246,6 +248,9 @@ type
|
||||
function GetHeightForImagePPI(AImageWidth, APPI: Integer): Integer;
|
||||
function GetCount: Integer;
|
||||
function GetSizeForImagePPI(AImageWidth, APPI: Integer): TSize;
|
||||
function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer;
|
||||
function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution;
|
||||
function GetResolutionCount: Integer;
|
||||
protected
|
||||
function GetResolution(AImageWidth: Integer): TCustomImageListResolution;
|
||||
function GetResolutionClass: TCustomImageListResolutionClass; virtual;
|
||||
@ -311,13 +316,15 @@ type
|
||||
procedure Move(ACurIndex, ANewIndex: Integer);
|
||||
procedure Overlay(AIndex: Integer; Overlay: TOverlay);
|
||||
property HasOverlays: boolean read fHasOverlays;
|
||||
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap);
|
||||
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor);
|
||||
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap; const AAllResolutions: Boolean = True);
|
||||
procedure ReplaceIcon(AIndex: Integer; AIcon: TCustomIcon);
|
||||
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor; const AAllResolutions: Boolean = True);
|
||||
procedure RegisterChanges(Value: TChangeLink);
|
||||
procedure StretchDraw(Canvas: TCanvas; Index: Integer; ARect: TRect; Enabled: Boolean = True);
|
||||
procedure UnRegisterChanges(Value: TChangeLink);
|
||||
|
||||
procedure RegisterResolutions(const AResolutionWidths: array of Integer);
|
||||
procedure DeleteResolution(const AWidth: Integer);
|
||||
public
|
||||
property AllocBy: Integer read FAllocBy write FAllocBy default 4;
|
||||
property BlendColor: TColor read FBlendColor write FBlendColor default clNone;
|
||||
@ -334,7 +341,9 @@ type
|
||||
property Reference[AImageWidth: Integer]: TWSCustomImageListReference read GetReference;
|
||||
property ReferenceForImagePPI[AImageWidth, APPI: Integer]: TWSCustomImageListReference read GetReferenceForImagePPI;
|
||||
property Resolution[AImageWidth: Integer]: TCustomImageListResolution read GetResolution;
|
||||
property ResolutionByIndex[AIndex: Integer]: TCustomImageListResolution read GetResolutionByIndex;
|
||||
property ResolutionForImagePPI[AImageWidth, APPI: Integer]: TCustomImageListResolution read GetResolutionForImagePPI;
|
||||
property ResolutionCount: Integer read GetResolutionCount;
|
||||
function Resolutions: TCustomImageListResolutionEnumerator;
|
||||
function ResolutionsDesc: TCustomImageListResolutionEnumerator;
|
||||
property ShareImages: Boolean read FShareImages write SetShareImages default False;
|
||||
|
||||
@ -57,7 +57,7 @@ begin
|
||||
FImgList := AImgList;
|
||||
FDesc := ADesc;
|
||||
if ADesc then
|
||||
FCurrent := FImgList.Count
|
||||
FCurrent := FImgList.FData.Count
|
||||
else
|
||||
FCurrent := -1;
|
||||
end;
|
||||
@ -510,7 +510,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomImageListResolution.InternalReplace(AIndex: Integer;
|
||||
AImage, AMask: HBitmap);
|
||||
AData: PRGBAQuad);
|
||||
var
|
||||
RawImage: TRawImage;
|
||||
R: TRect;
|
||||
@ -522,23 +522,7 @@ begin
|
||||
if (AIndex < 0) then AIndex := 0;
|
||||
CheckIndex(AIndex);
|
||||
|
||||
R := Rect(0, 0, FWidth, FHeight);
|
||||
RawImage_FromBitmap(RawImage, AImage, AMask, @R);
|
||||
LI := TLazIntfImage.Create(RawImage, True);
|
||||
SetLength(TargetData, FWidth * FHeight * SizeOf(TRGBAQuad));
|
||||
ImgData := @TargetData[0];
|
||||
for Y := 0 to FHeight-1 do
|
||||
for X := 0 to FWidth-1 do
|
||||
begin
|
||||
ImgData^.Alpha := Byte(LI.Colors[x, y].alpha);
|
||||
ImgData^.Red := Byte(LI.Colors[x, y].red);
|
||||
ImgData^.Green := Byte(LI.Colors[x, y].green);
|
||||
ImgData^.Blue := Byte(LI.Colors[x, y].blue);
|
||||
Inc(ImgData);
|
||||
end;
|
||||
LI.Free;
|
||||
|
||||
ImgData := InternalSetData(AIndex, @TargetData[0]);
|
||||
ImgData := InternalSetData(AIndex, AData);
|
||||
if HandleAllocated
|
||||
then TWSCustomImageListResolutionClass(WidgetSetClass).Replace(Self, AIndex, ImgData);
|
||||
end;
|
||||
@ -867,6 +851,16 @@ begin
|
||||
FResolutionClass := AResolutionClass;
|
||||
end;
|
||||
|
||||
procedure TCustomImageListResolutions.Clear;
|
||||
begin
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
procedure TCustomImageListResolutions.Delete(const AIndex: Integer);
|
||||
begin
|
||||
FList.Delete(AIndex);
|
||||
end;
|
||||
|
||||
destructor TCustomImageListResolutions.Destroy;
|
||||
begin
|
||||
FList.Free;
|
||||
@ -1213,8 +1207,7 @@ procedure TCustomImageList.Clear;
|
||||
var
|
||||
R: TCustomImageListResolution;
|
||||
begin
|
||||
for R in Resolutions do
|
||||
R.Clear;
|
||||
FData.Clear;
|
||||
|
||||
ClearOverlays;
|
||||
FChanged := True;
|
||||
@ -1300,6 +1293,14 @@ begin
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TCustomImageList.DeleteResolution(const AWidth: Integer);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if FData.Find(AWidth, I) then
|
||||
FData.Delete(I);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomImageList.Destroy
|
||||
Params: None
|
||||
@ -1531,11 +1532,22 @@ begin
|
||||
Result := FData.ImageLists[AImageWidth];
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetResolutionByIndex(
|
||||
AIndex: Integer): TCustomImageListResolution;
|
||||
begin
|
||||
Result := FData[AIndex];
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetResolutionClass: TCustomImageListResolutionClass;
|
||||
begin
|
||||
Result := TCustomImageListResolution;
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetResolutionCount: Integer;
|
||||
begin
|
||||
Result := FData.Count;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TCustomImageList.GetHotspot
|
||||
Params: None
|
||||
@ -1613,29 +1625,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomImageList.InsertIcon(AIndex: Integer; AIcon: TCustomIcon);
|
||||
function GetBestIndexForSize(AWidth: Integer): Integer;
|
||||
var
|
||||
MaxWidth, MaxWidthI: Integer;
|
||||
begin
|
||||
MaxWidth := 0;
|
||||
for Result := 0 to AIcon.Count-1 do // first try to find the smallest (but bigger) multiple
|
||||
begin
|
||||
AIcon.Current := Result;
|
||||
if (AIcon.Width mod AWidth = 0) then
|
||||
Exit;
|
||||
|
||||
if AIcon.Width>MaxWidth then
|
||||
begin
|
||||
MaxWidth := AIcon.Width;
|
||||
MaxWidthI := Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := MaxWidthI; // just pickup the biggest image
|
||||
end;
|
||||
var
|
||||
R: TCustomImageListResolution;
|
||||
BmpFree: Boolean;
|
||||
ScBmp: TRGBAQuadArray;
|
||||
msk: HBITMAP;
|
||||
begin
|
||||
@ -1644,7 +1635,7 @@ begin
|
||||
R := GetResolution(FWidth); // create default resolution if needed - do not create all icon resolutions
|
||||
for R in Resolutions do
|
||||
begin
|
||||
AIcon.Current := GetBestIndexForSize(R.Width);
|
||||
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width);
|
||||
if AIcon.Masked then
|
||||
msk := AIcon.MaskHandle
|
||||
else
|
||||
@ -1979,6 +1970,28 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetBestIconIndexForSize(AIcon: TCustomIcon;
|
||||
AWidth: Integer): Integer;
|
||||
var
|
||||
MaxWidth, MaxWidthI: Integer;
|
||||
begin
|
||||
MaxWidth := 0;
|
||||
for Result := 0 to AIcon.Count-1 do // first try to find the smallest (but bigger) multiple
|
||||
begin
|
||||
AIcon.Current := Result;
|
||||
if (AIcon.Width mod AWidth = 0) then
|
||||
Exit;
|
||||
|
||||
if AIcon.Width>MaxWidth then
|
||||
begin
|
||||
MaxWidth := AIcon.Width;
|
||||
MaxWidthI := Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := MaxWidthI; // just pickup the biggest image
|
||||
end;
|
||||
|
||||
procedure TCustomImageList.Overlay(AIndex: Integer; Overlay: TOverlay);
|
||||
var
|
||||
i: Integer;
|
||||
@ -2032,16 +2045,54 @@ end;
|
||||
Replaces the index'th image with the image given. If Mask is nil,
|
||||
the image has no transparent parts.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomImageList.Replace(AIndex: Integer; AImage, AMask: TCustomBitmap);
|
||||
procedure TCustomImageList.Replace(AIndex: Integer; AImage,
|
||||
AMask: TCustomBitmap; const AAllResolutions: Boolean);
|
||||
var
|
||||
msk: THandle;
|
||||
R: TCustomImageListResolution;
|
||||
Data: TRGBAQuadArray;
|
||||
|
||||
procedure _Replace;
|
||||
begin
|
||||
ScaleImage(AImage, AMask, R.Width, R.Height, Data);
|
||||
R.InternalReplace(AIndex, @Data[0]);
|
||||
end;
|
||||
begin
|
||||
if AImage = nil then Exit;
|
||||
|
||||
if AMask = nil
|
||||
then msk := 0
|
||||
else msk := AMask.Handle;
|
||||
GetResolution(AImage.Width).InternalReplace(AIndex, AImage.BitmapHandle, msk);
|
||||
if AAllResolutions then
|
||||
begin
|
||||
for R in Resolutions do
|
||||
_Replace;
|
||||
end else
|
||||
begin
|
||||
R := GetResolution(AImage.Width);
|
||||
_Replace;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomImageList.ReplaceIcon(AIndex: Integer; AIcon: TCustomIcon);
|
||||
var
|
||||
R: TCustomImageListResolution;
|
||||
ScBmp: TRGBAQuadArray;
|
||||
msk: HBITMAP;
|
||||
begin
|
||||
if AIcon = nil then Exit;
|
||||
|
||||
for R in Resolutions do
|
||||
begin
|
||||
AIcon.Current := GetBestIconIndexForSize(AIcon, R.Width);
|
||||
if AIcon.Masked then
|
||||
msk := AIcon.MaskHandle
|
||||
else
|
||||
msk := 0;
|
||||
ScaleImage(AIcon.BitmapHandle, msk,
|
||||
AIcon.Width, AIcon.Height, R.Width, R.Height, ScBmp);
|
||||
R.InternalReplace(AIndex, @ScBmp[0]);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2054,26 +2105,27 @@ end;
|
||||
Replaces the index'th image with the image given.
|
||||
Every occurrence of MaskColor will be converted to transparent.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomImageList.ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor);
|
||||
procedure TCustomImageList.ReplaceMasked(Index: Integer;
|
||||
NewImage: TCustomBitmap; MaskColor: TColor; const AAllResolutions: Boolean);
|
||||
var
|
||||
Bmp: TBitmap;
|
||||
R: TCustomImageListResolution;
|
||||
Data: TRGBAQuadArray;
|
||||
begin
|
||||
if NewImage = nil then Exit;
|
||||
|
||||
Bmp := TBitmap.Create;
|
||||
with Bmp do
|
||||
begin
|
||||
Assign(NewImage);
|
||||
TransparentColor := MaskColor;
|
||||
Transparent := True;
|
||||
end;
|
||||
try
|
||||
Bmp.Assign(NewImage);
|
||||
Bmp.TransparentColor := MaskColor;
|
||||
Bmp.Transparent := True;
|
||||
|
||||
R := GetResolution(NewImage.Width);
|
||||
if Bmp.Masked
|
||||
then R.InternalReplace(Index, Bmp.Handle, Bmp.MaskHandle)
|
||||
else R.InternalReplace(Index, Bmp.Handle, 0);
|
||||
Bmp.Free;
|
||||
R := GetResolution(NewImage.Width);
|
||||
ScaleImage(Bmp, nil, R.Width, R.Height, Data);
|
||||
R.InternalReplace(Index, @Data[0]);
|
||||
finally
|
||||
Bmp.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user