mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-11 10:48:43 +02:00
79f7f1bbf2
1. MarkAsChanged method (protected) is added, which sets FChanged to true. 2. Virtual DoAfterUpdateStarted and DoBeforeUpdateEnded methods (protected) are added. They are called in first BeginUpdate and last EndUpdate respectively.
485 lines
22 KiB
ObjectPascal
485 lines
22 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
imglist.pp
|
|
----------
|
|
Component Library TCustomImageList, TChangeLink Controls
|
|
Initial Revision : Fri Aug 16 21:00:00 CET 1999
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
|
|
{
|
|
@author(TCustomImageList - Marc Weustink <weus@quicknet.nl>)
|
|
@author(TChangeLink - Marc Weustink <weus@quicknet.nl>)
|
|
@created(16-Aug-1999)
|
|
@lastmod(26-feb-2003)
|
|
|
|
Detailed description of the Unit.
|
|
|
|
History
|
|
26-feb-2003 Olivier Guilbaud <golivier@free.fr>
|
|
- Add TCustomImageList.Assign()
|
|
- Add TCustomImageList.WriteData()
|
|
- Add TCustomImageList.ReadData()
|
|
- Add override TCustomImageList.DefineProperties()
|
|
Warning : the delphi or kylix format of datas is not compatible.
|
|
- Modify Delete and Clear for preserve memory
|
|
}
|
|
unit ImgList;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$modeswitch advancedrecords}
|
|
|
|
interface
|
|
|
|
{$ifdef Trace}
|
|
{$ASSERTIONS ON}
|
|
{$endif}
|
|
|
|
uses
|
|
// RTL + FCL
|
|
Types, math, SysUtils, Classes, RtlConsts, Contnrs, zstream, Laz_AVL_Tree,
|
|
FPReadBMP, FPimage, FPImgCanv, FPCanvas,
|
|
// LCL
|
|
LCLStrConsts, LCLIntf, LResources, LCLType, LCLProc, LCLClasses,
|
|
Graphics, IntfGraphics, WSReferences,
|
|
// LazUtils
|
|
GraphType, FPCAdds, LazLoggerBase, LazTracer, LazUtilities, AvgLvlTree;
|
|
|
|
type
|
|
TImageIndex = type integer;
|
|
|
|
{ TChangeLink }
|
|
{
|
|
@abstract(Use a TChangelink to get notified of imagelist changes)
|
|
Introduced by Marc Weustink <weus@quicknet.nl>
|
|
Currently maintained by Marc Weustink <weus@quicknet.nl>
|
|
}
|
|
|
|
TCustomImageList = class; //forward declaration
|
|
|
|
TDestroyResolutionHandleEvent = procedure(Sender: TCustomImageList; AWidth: Integer; AReferenceHandle: TLCLHandle) of object;
|
|
|
|
TChangeLink = class(TObject)
|
|
private
|
|
FSender: TCustomImageList;
|
|
FOnChange: TNotifyEvent;
|
|
FOnDestroyResolutionHandle: TDestroyResolutionHandleEvent;
|
|
|
|
procedure DoDestroyResolutionReference(const AWidth: Integer; AResolutionReference: TLCLHandle);
|
|
public
|
|
destructor Destroy; override;
|
|
procedure Change; virtual;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnDestroyResolutionHandle: TDestroyResolutionHandleEvent read FOnDestroyResolutionHandle write FOnDestroyResolutionHandle;
|
|
property Sender: TCustomImageList read FSender write FSender;
|
|
end;
|
|
|
|
{ TCustomImageList }
|
|
{
|
|
@abstract(Contains a list of images)
|
|
Introduced by Marc Weustink <marc@dommelstein.net>
|
|
|
|
Delphis TCustomImageList is based on the Win32 imagelists which has
|
|
internally only one bitmap to hold all images. This reduces handle
|
|
allocation.
|
|
The original TCustomImageList implementation was LCL only based, so for
|
|
other platforms the single bitmap implementation had some speed drawbacks.
|
|
Therefore it was implemented as list of bitmaps, however it doesnt reduce
|
|
handle allocation.
|
|
In its current form, the imagelist is again based on a 32bit RGBA raw
|
|
imagedata and the widgetset is notified when images are added or removed,
|
|
so the widgetset can create its own optimal storage. The LCL keeps only the
|
|
data, so all transparency info will be stored cross platform. (not all
|
|
platforms have a 8bit alpha channel).
|
|
|
|
NOTE: due to its implementation, the TCustomImageList is not a TBitmap
|
|
collection. If a fast storage of bitmaps is needed, create your own list!
|
|
}
|
|
|
|
// Some temp rework defines, for old functionality both need so be set
|
|
|
|
TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
|
|
TImageType = (itImage, itMask);
|
|
TOverlay = 0..14; // windows limitation
|
|
|
|
TCustomImageListResolution = class(TLCLReferenceComponent)
|
|
private
|
|
FWidth: Integer;
|
|
FHeight: Integer;
|
|
FData: array of TRGBAQuad;
|
|
FReference: TWSCustomImageListReference;
|
|
FAllocCount: Integer;
|
|
FImageList: TCustomImageList;
|
|
FCount: Integer;
|
|
FAutoCreatedInDesignTime: Boolean;
|
|
|
|
procedure AllocData(ACount: Integer);
|
|
function GetReference: TWSCustomImageListReference;
|
|
|
|
function Add(Image, Mask: TCustomBitmap): Integer;
|
|
procedure InternalInsert(AIndex: Integer; AData: PRGBAQuad); overload;
|
|
procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean);
|
|
procedure InternalReplace(AIndex: Integer; AData: PRGBAQuad);
|
|
function InternalSetData(AIndex: Integer; AData: PRGBAQuad): PRGBAQuad;
|
|
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
|
|
|
|
procedure Clear;
|
|
procedure Delete(AIndex: Integer);
|
|
|
|
procedure GetFullRawImage(out Image: TRawImage);
|
|
|
|
procedure AddImages(AValue: TCustomImageListResolution);
|
|
|
|
procedure WriteData(AStream: TStream; const ACompress: Boolean);
|
|
procedure ReadData(AStream: TStream);
|
|
protected
|
|
function GetReferenceHandle: THandle; override;
|
|
function WSCreateReference(AParams: TCreateParams): PWSReference; override;
|
|
class procedure WSRegisterClass; override;
|
|
procedure ReferenceDestroying; override;
|
|
public
|
|
destructor Destroy; override;
|
|
public
|
|
function GetHotSpot: TPoint; virtual;
|
|
procedure FillDescription(out ADesc: TRawImageDescription);
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap; AEffect: TGraphicsDrawEffect); overload;
|
|
procedure GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect); overload;
|
|
procedure GetIcon(Index: Integer; Image: TIcon); overload;
|
|
procedure GetFullBitmap(Image: TCustomBitmap; AEffect: TGraphicsDrawEffect = gdeNormal);
|
|
procedure GetRawImage(Index: Integer; out Image: TRawImage);
|
|
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
ADrawEffect: TGraphicsDrawEffect); overload; virtual;
|
|
procedure StretchDraw(Canvas: TCanvas; Index: Integer; ARect: TRect; Enabled: Boolean = True);
|
|
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; AEnabled: Boolean = True); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
|
|
TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
|
|
property ImageList: TCustomImageList read FImageList;
|
|
property Width: Integer read FWidth;
|
|
property Height: Integer read FHeight;
|
|
property Count: Integer read FCount;
|
|
|
|
property AutoCreatedInDesignTime: Boolean read FAutoCreatedInDesignTime write FAutoCreatedInDesignTime;
|
|
|
|
property Reference: TWSCustomImageListReference read GetReference;
|
|
end;
|
|
|
|
{ TScaledImageListResolution }
|
|
|
|
TScaledImageListResolution = record
|
|
private
|
|
FResolution: TCustomImageListResolution;
|
|
FScaleFactor: Double;
|
|
FWidth: Integer;
|
|
FHeight: Integer;
|
|
function GetCount: Integer;
|
|
function GetSize: TSize;
|
|
function GetValid: Boolean;
|
|
public
|
|
class function Create(AResolution: TCustomImageListResolution;
|
|
const AScaleFactor: Double): TScaledImageListResolution; static; // FPC record constructor bug
|
|
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap; AEffect: TGraphicsDrawEffect); overload;
|
|
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure StretchDraw(Canvas: TCanvas; Index: Integer; ARect: TRect; Enabled: Boolean = True);
|
|
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; AEnabled: Boolean = True); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
|
|
TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
|
|
property Width: Integer read FWidth;
|
|
property Height: Integer read FHeight;
|
|
property Size: TSize read GetSize;
|
|
property Resolution: TCustomImageListResolution read FResolution;
|
|
property Count: Integer read GetCount;
|
|
property Valid: Boolean read GetValid;
|
|
end;
|
|
|
|
TCustomImageListResolutionClass = class of TCustomImageListResolution;
|
|
TCustomImageListResolutions = class(TObject)
|
|
private
|
|
FList: TObjectList;
|
|
FImageList: TCustomImageList;
|
|
FResolutionClass: TCustomImageListResolutionClass;
|
|
|
|
function Find(const AImageWidth: Integer; out Index: Integer): Boolean;
|
|
function GetImageLists(const AImageWidth: Integer): TCustomImageListResolution;
|
|
function GetImageLists(const AImageWidth: Integer; const AScaleFromExisting,
|
|
AutoCreatedInDesignTime: Boolean): TCustomImageListResolution;
|
|
function GetItems(const AIndex: Integer): TCustomImageListResolution;
|
|
function GetCount: Integer;
|
|
function FindBestToCopyFrom(const ATargetWidth, AIgnoreIndex: Integer): Integer;
|
|
public
|
|
constructor Create(const AImageList: TCustomImageList; const AResolutionClass: TCustomImageListResolutionClass);
|
|
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;
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
TCustomImageListResolutionEnumerator = class
|
|
private
|
|
FCurrent: Integer;
|
|
FImgList: TCustomImageList;
|
|
FDesc: Boolean;
|
|
function GetCurrent: TCustomImageListResolution;
|
|
public
|
|
function GetEnumerator: TCustomImageListResolutionEnumerator;
|
|
constructor Create(AImgList: TCustomImageList; ADesc: Boolean);
|
|
function MoveNext: Boolean;
|
|
property Current: TCustomImageListResolution read GetCurrent;
|
|
end;
|
|
|
|
TCustomImageListGetWidthForPPI = procedure(Sender: TCustomImageList;
|
|
AImageWidth, APPI: Integer; var AResultWidth: Integer) of object;
|
|
|
|
TCustomImageList = class(TLCLComponent)
|
|
private
|
|
FDrawingStyle: TDrawingStyle;
|
|
FData: TCustomImageListResolutions;
|
|
FImageType: TImageType;
|
|
FHeight: Integer;
|
|
FMasked: boolean;
|
|
FShareImages: Boolean;
|
|
FWidth: Integer;
|
|
FAllocBy: Integer;
|
|
FBlendColor: TColor;
|
|
FOnChange: TNotifyEvent;
|
|
FChangeLinkList: TList;
|
|
FBkColor: TColor;
|
|
FChanged: boolean;
|
|
FUpdateCount: integer;
|
|
FOverlays: array[TOverlay] of Integer;
|
|
fHasOverlays: boolean;
|
|
FOnGetWidthForPPI: TCustomImageListGetWidthForPPI;
|
|
FScaled: Boolean;
|
|
|
|
procedure NotifyChangeLink;
|
|
procedure SetBkColor(const Value: TColor);
|
|
procedure SetDrawingStyle(const AValue: TDrawingStyle);
|
|
procedure SetHeight(const Value: Integer);
|
|
procedure SetMasked(const AValue: boolean);
|
|
procedure SetShareImages(const AValue: Boolean);
|
|
procedure SetWidth(const Value: Integer);
|
|
function GetReference(AImageWidth: Integer): TWSCustomImageListReference;
|
|
function GetReferenceForPPI(AImageWidth, APPI: Integer): TWSCustomImageListReference;
|
|
function GetResolutionForPPI(AImageWidth, APPI: Integer;
|
|
const ACanvasScaleFactor: Double): TScaledImageListResolution;
|
|
function GetWidthForPPI(AImageWidth, APPI: Integer): Integer;
|
|
function GetHeightForPPI(AImageWidth, APPI: Integer): Integer;
|
|
function GetHeightForWidth(AWidth: Integer): Integer;
|
|
function GetCount: Integer;
|
|
function GetSizeForPPI(AImageWidth, APPI: Integer): TSize;
|
|
function GetBestIconIndexForSize(AIcon: TCustomIcon; AWidth: Integer): Integer; // the icon must be sorted
|
|
function GetResolutionByIndex(AIndex: Integer): TCustomImageListResolution;
|
|
function GetResolutionCount: Integer;
|
|
procedure CreateDefaultResolution;
|
|
procedure DoDestroyResolutionReference(const AWidth: Integer; AResolutionReference: TLCLHandle);
|
|
protected
|
|
function GetResolution(AImageWidth: Integer): TCustomImageListResolution;
|
|
function GetResolutionClass: TCustomImageListResolutionClass; virtual;
|
|
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
|
|
procedure Initialize; virtual;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure SetWidthHeight(NewWidth, NewHeight: integer);
|
|
procedure ClearOverlays;
|
|
procedure MarkAsChanged;
|
|
procedure DoAfterUpdateStarted; virtual;
|
|
procedure DoBeforeUpdateEnded; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor CreateSize(AWidth, AHeight: Integer);
|
|
destructor Destroy; override;
|
|
|
|
class procedure ScaleImage(const ABitmap, AMask: TCustomBitmap;
|
|
TargetWidth, TargetHeight: Integer; var AData: TRGBAQuadArray);
|
|
class procedure ScaleImage(const ABitmap, AMask: TCustomBitmap;
|
|
SourceRect: TRect; TargetWidth, TargetHeight: Integer; var AData: TRGBAQuadArray);
|
|
class procedure ScaleImage(const ABitmap, AMask: HBITMAP;
|
|
SourceRect: TRect; TargetWidth, TargetHeight: Integer; var AData: TRGBAQuadArray);
|
|
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure WriteData(AStream: TStream); virtual;
|
|
procedure ReadData(AStream: TStream); virtual;
|
|
procedure WriteAdvData(AStream: TStream); virtual;
|
|
procedure ReadAdvData(AStream: TStream); virtual;
|
|
function Equals(Obj: TObject): boolean;
|
|
{$IF FPC_FULLVERSION>=20402}override;{$ENDIF}
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
|
|
function Add(Image, Mask: TCustomBitmap): Integer;
|
|
function AddMultipleResolutions(Images: array of TCustomBitmap): Integer; // always pass sorted array from smallest to biggest
|
|
function AddMultipleResolutions(Images: array of TRasterImage): Integer; // always pass sorted array from smallest to biggest
|
|
function AddSliced(Image: TCustomBitmap; AHorizontalCount, AVerticalCount: Integer): Integer;
|
|
function AddSlice(Image: TCustomBitmap; AImageRect: TRect): Integer;
|
|
function AddSliceCentered(Image: TCustomBitmap): Integer;
|
|
function AddIcon(Image: TCustomIcon): Integer;
|
|
procedure AddImages(AValue: TCustomImageList);
|
|
function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
|
|
function AddLazarusResource(const ResourceName: string; MaskColor: TColor = clNone): integer;
|
|
function AddResourceName(Instance: THandle; const ResourceName: string; MaskColor: TColor = clNone): integer;
|
|
procedure Change;
|
|
procedure Clear;
|
|
procedure Delete(AIndex: Integer);
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
AEnabled: Boolean = True); overload;
|
|
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
|
|
ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure DrawForPPI(ACanvas: TCanvas; AX, AY, AIndex: Integer;
|
|
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double; AEnabled: Boolean = True); overload;
|
|
procedure DrawForPPI(ACanvas: TCanvas; AX, AY, AIndex: Integer;
|
|
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; AEnabled: Boolean = True); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
|
|
TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); overload;
|
|
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
|
|
procedure GetBitmap(Index: Integer; Image: TCustomBitmap; AEffect: TGraphicsDrawEffect); overload;
|
|
procedure GetFullBitmap(Image: TCustomBitmap; AEffect: TGraphicsDrawEffect = gdeNormal);
|
|
procedure GetFullRawImage(out Image: TRawImage);
|
|
|
|
procedure GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect); overload;
|
|
procedure GetIcon(Index: Integer; Image: TIcon); overload;
|
|
procedure GetRawImage(Index: Integer; out Image: TRawImage);
|
|
function GetHotSpot: TPoint;
|
|
|
|
procedure Insert(AIndex: Integer; AImage, AMask: TCustomBitmap);
|
|
procedure InsertIcon(AIndex: Integer; AIcon: TCustomIcon);
|
|
procedure InsertMasked(Index: Integer; AImage: TCustomBitmap; MaskColor: TColor);
|
|
procedure Move(ACurIndex, ANewIndex: Integer);
|
|
procedure Overlay(AIndex: Integer; Overlay: TOverlay);
|
|
property HasOverlays: boolean read fHasOverlays;
|
|
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap; const AllResolutions: Boolean = True);
|
|
procedure ReplaceSlice(AIndex: Integer; Image: TCustomBitmap; AImageRect: TRect; const AllResolutions: Boolean = True);
|
|
procedure ReplaceSliceCentered(AIndex, AImageWidth: Integer; Image: TCustomBitmap; const AllResolutions: Boolean = True);
|
|
procedure ReplaceIcon(AIndex: Integer; AIcon: TCustomIcon);
|
|
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor; const AllResolutions: 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); virtual;
|
|
procedure DeleteResolution(const AWidth: Integer);
|
|
function FindResolution(AImageWidth: Integer; out AResolution: TCustomImageListResolution): Boolean;
|
|
public
|
|
property AllocBy: Integer read FAllocBy write FAllocBy default 4;
|
|
property BlendColor: TColor read FBlendColor write FBlendColor default clNone;
|
|
property BkColor: TColor read FBkColor write SetBkColor default clNone;
|
|
property Count: Integer read GetCount;
|
|
property DrawingStyle: TDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal;
|
|
property Height: Integer read FHeight write SetHeight default 16;
|
|
property HeightForPPI[AImageWidth, APPI: Integer]: Integer read GetHeightForPPI;
|
|
property HeightForWidth[AWidth: Integer]: Integer read GetHeightForWidth;
|
|
property Width: Integer read FWidth write SetWidth default 16;
|
|
property WidthForPPI[AImageWidth, APPI: Integer]: Integer read GetWidthForPPI;
|
|
property SizeForPPI[AImageWidth, APPI: Integer]: TSize read GetSizeForPPI;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property Masked: boolean read FMasked write SetMasked default False;
|
|
property Reference[AImageWidth: Integer]: TWSCustomImageListReference read GetReference;
|
|
property ReferenceForPPI[AImageWidth, APPI: Integer]: TWSCustomImageListReference read GetReferenceForPPI;
|
|
property Resolution[AImageWidth: Integer]: TCustomImageListResolution read GetResolution;
|
|
property ResolutionByIndex[AIndex: Integer]: TCustomImageListResolution read GetResolutionByIndex;
|
|
property ResolutionForPPI[AImageWidth, APPI: Integer; const ACanvasScaleFactor: Double]: TScaledImageListResolution read GetResolutionForPPI;
|
|
property ResolutionCount: Integer read GetResolutionCount;
|
|
function Resolutions: TCustomImageListResolutionEnumerator;
|
|
function ResolutionsDesc: TCustomImageListResolutionEnumerator;
|
|
property Scaled: Boolean read FScaled write FScaled default False;
|
|
property ShareImages: Boolean read FShareImages write SetShareImages default False;
|
|
property ImageType: TImageType read FImageType write FImageType default itImage;
|
|
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 and TLCLGlyphs.GetImageIndex Result is -1 if no resolution is found.
|
|
|
|
TLCLGlyphs = class(TCustomImageList)
|
|
private type
|
|
TEntryKey = record
|
|
GlyphName: string;
|
|
end;
|
|
PEntryKey = ^TEntryKey;
|
|
|
|
TEntry = class
|
|
public
|
|
// key
|
|
GlyphName: string;
|
|
|
|
// value
|
|
ImageIndex: Integer; // the image index in TLCLGlyphs
|
|
end;
|
|
TResolution = record
|
|
Width: Integer;
|
|
ScaleSuffix: Integer;
|
|
end;
|
|
|
|
private
|
|
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 MissingResources: TLCLGlyphsMissingResources read FMissingResources write FMissingResources;
|
|
end;
|
|
|
|
function LCLGlyphs: TLCLGlyphs;
|
|
function GetDefaultGlyph(ResourceName: string; ScalePercent: Integer = 100;
|
|
IgnoreMissingResource: Boolean = False): TCustomBitmap;
|
|
|
|
implementation
|
|
|
|
uses
|
|
WSImglist;
|
|
|
|
{$I imglist.inc}
|
|
|
|
end.
|
|
|