mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-15 02:54:07 +08:00
1352 lines
38 KiB
ObjectPascal
1352 lines
38 KiB
ObjectPascal
unit PngImageList;
|
|
|
|
{$I compilers.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Classes, SysUtils, Controls, Graphics, CommCtrl, ImgList, PngImage,
|
|
PngFunctions, ComCtrls;
|
|
|
|
type
|
|
TPngImageCollection = class;
|
|
TPngImageCollectionItem = class;
|
|
TPngImageCollectionItems = class;
|
|
|
|
TPngImageList = class(TImageList)
|
|
private
|
|
FPngImages: TPngImageCollectionItems;
|
|
FEnabledImages: Boolean;
|
|
FPngOptions: TPngOptions;
|
|
FLocked: Integer;
|
|
procedure SetPngOptions(const Value: TPngOptions);
|
|
{$IFNDEF COMPILER_7_UP}
|
|
procedure ReadLeft(Reader: TReader);
|
|
procedure ReadTop(Reader: TReader);
|
|
procedure WriteLeft(Writer: TWriter);
|
|
procedure WriteTop(Writer: TWriter);
|
|
{$ENDIF}
|
|
procedure SetWidth(const Value: Integer);
|
|
procedure SetHeight(const Value: Integer);
|
|
function GetWidth: Integer;
|
|
function GetHeight: Integer;
|
|
protected
|
|
procedure SetEnabledImages(const Value: Boolean); virtual;
|
|
procedure SetPngImages(const Value: TPngImageCollectionItems); virtual;
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
function PngToIcon(const Png: TPNGObject; Background: TColor = clNone): HICON;
|
|
procedure CopyPngs; virtual;
|
|
procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean = True); override;
|
|
{$IFDEF COMPILER_7_UP}
|
|
procedure ReadData(Stream: TStream); override;
|
|
procedure WriteData(Stream: TStream); override;
|
|
{$ELSE}
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate(Update: Boolean = True);
|
|
procedure InsertPng(Index: Integer; const Png: TPNGObject; Background: TColor = clNone);
|
|
//Patched methods
|
|
function Add(Image, Mask: TBitmap): Integer; virtual;
|
|
function AddIcon(Image: TIcon): Integer; virtual;
|
|
{$IFDEF COMPILER_7_UP}
|
|
function AddImage(Value: TCustomImageList; Index: Integer): Integer; virtual;
|
|
{$ENDIF}
|
|
procedure AddImages(Value: TCustomImageList); virtual;
|
|
function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; virtual;
|
|
procedure Clear; virtual;
|
|
procedure Delete(Index: Integer); virtual;
|
|
procedure Insert(Index: Integer; Image, Mask: TBitmap); virtual;
|
|
procedure InsertIcon(Index: Integer; Image: TIcon); virtual;
|
|
procedure InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor); virtual;
|
|
procedure Move(CurIndex, NewIndex: Integer); virtual;
|
|
procedure Replace(Index: Integer; Image, Mask: TBitmap); virtual;
|
|
procedure ReplaceIcon(Index: Integer; Image: TIcon); virtual;
|
|
procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor); virtual;
|
|
published
|
|
property EnabledImages: Boolean read FEnabledImages write SetEnabledImages default True;
|
|
property PngImages: TPngImageCollectionItems read FPngImages write SetPngImages;
|
|
property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
|
|
property Width read GetWidth write SetWidth default 16;
|
|
property Height read GetHeight write SetHeight default 16;
|
|
end;
|
|
|
|
TPngImageCollection = class(TComponent)
|
|
private
|
|
FItems: TPngImageCollectionItems;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Items: TPngImageCollectionItems read FItems write FItems;
|
|
end;
|
|
|
|
TPngImageCollectionItems = class(TCollection)
|
|
private
|
|
FOwner: TPersistent;
|
|
function GetItem(Index: Integer): TPngImageCollectionItem;
|
|
procedure SetItem(Index: Integer; const Value: TPngImageCollectionItem);
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
property Items[index: Integer]: TPngImageCollectionItem read GetItem write SetItem; default;
|
|
function Add(DontCreatePNG: Boolean = False): TPngImageCollectionItem; reintroduce;
|
|
function Insert(Index: Integer; DontCreatePNG: Boolean = False): TPngImageCollectionItem; reintroduce;
|
|
procedure Assign(Source: TPersistent); override;
|
|
end;
|
|
|
|
TPngImageCollectionItem = class(TCollectionItem)
|
|
private
|
|
FPngImage: TPNGObject;
|
|
FName: string;
|
|
FBackground: TColor;
|
|
procedure SetPngImage(const Value: TPNGObject);
|
|
procedure SetBackground(const Value: TColor);
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
function GetDisplayName: string; override;
|
|
public
|
|
constructor Create(Collection: TCollection); overload; override;
|
|
constructor Create(Collection: TCollection; DontCreatePNG: Boolean = False); reintroduce; overload;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function Duplicate: TPNGObject;
|
|
published
|
|
property PngImage: TPNGObject read FPngImage write SetPngImage;
|
|
property Name: string read FName write FName;
|
|
property Background: TColor read FBackground write SetBackground default clBtnFace;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses Math, Contnrs;
|
|
|
|
var
|
|
ImageListCount: Integer = 0;
|
|
MethodPatches: TObjectList = nil;
|
|
|
|
type
|
|
TMethodPatch = class
|
|
OldPointer, NewPointer: Pointer;
|
|
OldBody: array[0..5] of Byte;
|
|
Name: string;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function PatchBack: Boolean;
|
|
procedure BeginInvokeOldMethod;
|
|
procedure FinishInvokeOldMethod;
|
|
end;
|
|
|
|
{ Global }
|
|
|
|
function FindMethodPatch(const Name: string): TMethodPatch;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to MethodPatches.Count - 1
|
|
do if TMethodPatch(MethodPatches[I]).Name = Name
|
|
then begin
|
|
Result := TMethodPatch(MethodPatches[I]);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function PatchPtr(OldPtr, NewPtr: Pointer; const Name: string; Patch: TMethodPatch): Boolean;
|
|
var
|
|
Access: Cardinal;
|
|
begin
|
|
Result := False;
|
|
Patch.Name := Name;
|
|
if OldPtr <> NewPtr
|
|
then with Patch
|
|
do begin
|
|
OldPointer := OldPtr;
|
|
NewPointer := NewPtr;
|
|
Move(PByte(OldPtr)^, OldBody[0], SizeOf(OldBody));
|
|
if VirtualProtect(OldPtr, 16, PAGE_READWRITE, @Access)
|
|
then begin
|
|
PByte(OldPtr)^ := $E9; // Near jump
|
|
PCardinal(Cardinal(OldPtr)+ 1)^ := Cardinal(NewPtr)- Cardinal(OldPtr)- 5;
|
|
VirtualProtect(OldPtr, 16, Access, @Access);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
if not Result
|
|
then Patch.OldPointer := nil;
|
|
end;
|
|
|
|
procedure ApplyMethodPatches;
|
|
type
|
|
TPointerCombo = record
|
|
OldPtr, NewPtr: Pointer;
|
|
Name: string;
|
|
end;
|
|
|
|
function Combo(OldPtr, NewPtr: Pointer; const Name: string): TPointerCombo;
|
|
begin
|
|
Result.OldPtr := OldPtr;
|
|
Result.NewPtr := NewPtr;
|
|
Result.Name := Name;
|
|
end;
|
|
|
|
const
|
|
EmptyCombo: TPointerCombo = (OldPtr: nil; NewPtr: nil; Name: '');
|
|
var
|
|
Pointers: array of TPointerCombo;
|
|
Patch: TMethodPatch;
|
|
I: Integer;
|
|
begin
|
|
if ImageListCount = 0
|
|
then begin
|
|
SetLength(Pointers, 14);
|
|
Pointers[0] := Combo(@TCustomImageList.Add, @TPngImageList.Add, 'Add');
|
|
Pointers[1] := Combo(@TCustomImageList.AddIcon, @TPngImageList.AddIcon, 'AddIcon');
|
|
{$IFDEF COMPILER_7_UP}
|
|
Pointers[2] := Combo(@TCustomImageList.AddImage, @TPngImageList.AddImage, 'AddImage');
|
|
{$ELSE}
|
|
Pointers[2] := EmptyCombo;
|
|
{$ENDIF}
|
|
Pointers[3] := Combo(@TCustomImageList.AddImages, @TPngImageList.AddImages, 'AddImages');
|
|
Pointers[4] := Combo(@TCustomImageList.AddMasked, @TPngImageList.AddMasked, 'AddMasked');
|
|
Pointers[5] := Combo(@TCustomImageList.Clear, @TPngImageList.Clear, 'Clear');
|
|
Pointers[6] := Combo(@TCustomImageList.Delete, @TPngImageList.Delete, 'Delete');
|
|
Pointers[7] := Combo(@TCustomImageList.Insert, @TPngImageList.Insert, 'Insert');
|
|
Pointers[8] := Combo(@TCustomImageList.InsertIcon, @TPngImageList.InsertIcon, 'InsertIcon');
|
|
Pointers[9] := Combo(@TCustomImageList.InsertMasked, @TPngImageList.InsertMasked, 'InsertMasked');
|
|
Pointers[10] := Combo(@TCustomImageList.Move, @TPngImageList.Move, 'Move');
|
|
Pointers[11] := Combo(@TCustomImageList.Replace, @TPngImageList.Replace, 'Replace');
|
|
Pointers[12] := Combo(@TCustomImageList.ReplaceIcon, @TPngImageList.ReplaceIcon, 'ReplaceIcon');
|
|
Pointers[13] := Combo(@TCustomImageList.ReplaceMasked, @TPngImageList.ReplaceMasked, 'ReplaceMasked');
|
|
|
|
MethodPatches := TObjectList.Create;
|
|
for I := Low(Pointers) to High(Pointers)
|
|
do if Pointers[I].OldPtr <> nil
|
|
then begin
|
|
Patch := TMethodPatch.Create;
|
|
if PatchPtr(Pointers[I].OldPtr, Pointers[I].NewPtr, Pointers[I].Name, Patch)
|
|
then MethodPatches.Add(Patch)
|
|
else Patch.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure RevertPatchedMethods;
|
|
begin
|
|
if ImageListCount = 0
|
|
then FreeAndNil(MethodPatches);
|
|
end;
|
|
|
|
{ TMethodPatch }
|
|
|
|
constructor TMethodPatch.Create;
|
|
begin
|
|
inherited Create;
|
|
OldPointer := nil;
|
|
end;
|
|
|
|
destructor TMethodPatch.Destroy;
|
|
begin
|
|
if OldPointer <> nil
|
|
then PatchBack;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TMethodPatch.PatchBack: Boolean;
|
|
var
|
|
Access: Cardinal;
|
|
begin
|
|
Result := False;
|
|
if VirtualProtect(OldPointer, 16, PAGE_READWRITE, @Access)
|
|
then begin
|
|
Move(OldBody[0], OldPointer^, SizeOf(OldBody));
|
|
VirtualProtect(OldPointer, 16, Access, @Access);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TMethodPatch.BeginInvokeOldMethod;
|
|
begin
|
|
PatchBack;
|
|
end;
|
|
|
|
procedure TMethodPatch.FinishInvokeOldMethod;
|
|
begin
|
|
PatchPtr(OldPointer, NewPointer, Name, Self);
|
|
end;
|
|
|
|
{ TPngImageList }
|
|
|
|
procedure TPngImageList.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited AssignTo(Dest);
|
|
if Dest is TPngImageList
|
|
then begin
|
|
TPngImageList(Dest).PngImages := FPngImages;
|
|
TPngImageList(Dest).EnabledImages := FEnabledImages;
|
|
end;
|
|
end;
|
|
|
|
function TPngImageList.PngToIcon(const Png: TPNGObject; Background: TColor = clNone): HICON;
|
|
const
|
|
MaxRGBQuads = MaxInt div SizeOf(TRGBQuad) - 1;
|
|
type
|
|
TRGBQuadArray = array[0..MaxRGBQuads] of TRGBQuad;
|
|
PRGBQuadArray = ^TRGBQuadArray;
|
|
TBitmapInfo4 = packed record
|
|
bmiHeader: TBitmapV4Header;
|
|
bmiColors: array[0..0] of TRGBQuad;
|
|
end;
|
|
|
|
function PngToIcon32(Png: TPNGObject): HIcon;
|
|
var
|
|
ImageBits: PRGBQuadArray;
|
|
BitmapInfo: TBitmapInfo4;
|
|
IconInfo: TIconInfo;
|
|
AlphaBitmap: HBitmap;
|
|
MaskBitmap: TBitmap;
|
|
X, Y: Integer;
|
|
AlphaLine: PByteArray;
|
|
HasAlpha, HasBitmask: Boolean;
|
|
Color, TransparencyColor: TColor;
|
|
begin
|
|
//Convert a PNG object to an alpha-blended icon resource
|
|
ImageBits := nil;
|
|
|
|
//Allocate a DIB for the color data and alpha channel
|
|
with BitmapInfo.bmiHeader
|
|
do begin
|
|
bV4Size := SizeOf(BitmapInfo.bmiHeader);
|
|
bV4Width := Png.Width;
|
|
bV4Height := Png.Height;
|
|
bV4Planes := 1;
|
|
bV4BitCount := 32;
|
|
bV4V4Compression := BI_BITFIELDS;
|
|
bV4SizeImage := 0;
|
|
bV4XPelsPerMeter := 0;
|
|
bV4YPelsPerMeter := 0;
|
|
bV4ClrUsed := 0;
|
|
bV4ClrImportant := 0;
|
|
bV4RedMask := $00FF0000;
|
|
bV4GreenMask := $0000FF00;
|
|
bV4BlueMask := $000000FF;
|
|
bV4AlphaMask := $FF000000;
|
|
end;
|
|
AlphaBitmap := CreateDIBSection(0, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS, Pointer(ImageBits), 0, 0);
|
|
try
|
|
//Spin through and fill it with a wash of color and alpha.
|
|
AlphaLine := nil;
|
|
HasAlpha := Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA];
|
|
HasBitmask := Png.TransparencyMode = ptmBit;
|
|
TransparencyColor := Png.TransparentColor;
|
|
for Y := 0 to Png.Height - 1
|
|
do begin
|
|
if HasAlpha
|
|
then AlphaLine := Png.AlphaScanline[Png.Height - Y - 1];
|
|
for X := 0 to Png.Width - 1
|
|
do begin
|
|
Color := Png.Pixels[X, Png.Height - Y - 1];
|
|
ImageBits^[Y * Png.Width + X].rgbRed := Color and $FF;
|
|
ImageBits^[Y * Png.Width + X].rgbGreen := Color shr 8 and $FF;
|
|
ImageBits^[Y * Png.Width + X].rgbBlue := Color shr 16 and $FF;
|
|
if HasAlpha
|
|
then ImageBits^[Y * Png.Width + X].rgbReserved := AlphaLine^[X]
|
|
else if HasBitmask
|
|
then ImageBits^[Y * Png.Width + X].rgbReserved := Integer(Color <> TransparencyColor) * 255;
|
|
end;
|
|
end;
|
|
|
|
//Create an empty mask
|
|
MaskBitmap := TBitmap.Create;
|
|
try
|
|
MaskBitmap.Width := Png.Width;
|
|
MaskBitmap.Height := Png.Height;
|
|
MaskBitmap.PixelFormat := pf1bit;
|
|
MaskBitmap.Canvas.Brush.Color := clBlack;
|
|
MaskBitmap.Canvas.FillRect(Rect(0, 0, MaskBitmap.Width, MaskBitmap.Height));
|
|
|
|
//Create the alpha blended icon
|
|
IconInfo.fIcon := True;
|
|
IconInfo.hbmColor := AlphaBitmap;
|
|
IconInfo.hbmMask := MaskBitmap.Handle;
|
|
Result := CreateIconIndirect(IconInfo);
|
|
finally
|
|
MaskBitmap.Free;
|
|
end;
|
|
finally
|
|
DeleteObject(AlphaBitmap);
|
|
end;
|
|
end;
|
|
|
|
function PngToIcon24(Png: TPNGObject; Background: TColor): HIcon;
|
|
var
|
|
ColorBitmap, MaskBitmap: TBitmap;
|
|
X, Y: Integer;
|
|
AlphaLine: PByteArray;
|
|
IconInfo: TIconInfo;
|
|
TransparencyColor: TColor;
|
|
begin
|
|
ColorBitmap := TBitmap.Create;
|
|
MaskBitmap := TBitmap.Create;
|
|
try
|
|
ColorBitmap.Width := Png.Width;
|
|
ColorBitmap.Height := Png.Height;
|
|
ColorBitmap.PixelFormat := pf32bit;
|
|
MaskBitmap.Width := Png.Width;
|
|
MaskBitmap.Height := Png.Height;
|
|
MaskBitmap.PixelFormat := pf32bit;
|
|
|
|
//Draw the color bitmap
|
|
ColorBitmap.Canvas.Brush.Color := Background;
|
|
ColorBitmap.Canvas.FillRect(Rect(0, 0, Png.Width, Png.Height));
|
|
Png.Draw(ColorBitmap.Canvas, Rect(0, 0, Png.Width, Png.Height));
|
|
|
|
//Create the mask bitmap
|
|
if Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA]
|
|
then for Y := 0 to Png.Height - 1
|
|
do begin
|
|
AlphaLine := Png.AlphaScanline[Y];
|
|
for X := 0 to Png.Width - 1
|
|
do if AlphaLine^[X] = 0
|
|
then SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clWhite)
|
|
else SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clBlack);
|
|
end
|
|
else if Png.TransparencyMode = ptmBit
|
|
then begin
|
|
TransparencyColor := Png.TransparentColor;
|
|
for Y := 0 to Png.Height - 1
|
|
do for X := 0 to Png.Width - 1
|
|
do if Png.Pixels[X, Y] = TransparencyColor
|
|
then SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clWhite)
|
|
else SetPixelV(MaskBitmap.Canvas.Handle, X, Y, clBlack);
|
|
end;
|
|
|
|
//Create the icon
|
|
IconInfo.fIcon := True;
|
|
IconInfo.hbmColor := ColorBitmap.Handle;
|
|
IconInfo.hbmMask := MaskBitmap.Handle;
|
|
Result := CreateIconIndirect(IconInfo);
|
|
finally
|
|
ColorBitmap.Free;
|
|
MaskBitmap.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if {$IFDEF COMPILER_7_UP}
|
|
GetComCtlVersion >= ComCtlVersionIE6
|
|
{$ELSE} False {$ENDIF} then
|
|
//Windows XP or later, using the modern method: convert every PNG to
|
|
//an icon resource with alpha channel
|
|
Result := PngToIcon32(Png)
|
|
else
|
|
//No Windows XP, using the legacy method: copy every PNG to a normal
|
|
//bitmap using a fixed background color
|
|
Result := PngToIcon24(Png, Background);
|
|
end;
|
|
|
|
procedure TPngImageList.CopyPngs;
|
|
var
|
|
I: Integer;
|
|
Png: TPNGObject;
|
|
Icon: HIcon;
|
|
begin
|
|
//Are we adding a bunch of images?
|
|
if FLocked > 0
|
|
then Exit;
|
|
|
|
//Copy PNG images to the imagelist. These images will not be stored in the DFM.
|
|
ImageList_Remove(Handle, -1);
|
|
Handle := ImageList_Create(Width, Height, ILC_COLOR32 or (Integer(Masked) * ILC_MASK), 0, AllocBy);
|
|
|
|
if not FEnabledImages and (FPngOptions <> [])
|
|
then Png := TPNGObject.Create
|
|
else Png := nil; //<- To prevent a compiler warning
|
|
try
|
|
for I := 0 to FPngImages.Count - 1
|
|
do begin
|
|
if TPngImageCollectionItem(FPngImages.Items[I]).PngImage = nil
|
|
then Continue;
|
|
if FEnabledImages or (FPngOptions = [])
|
|
then Icon := PngToIcon(FPngImages.Items[I].PngImage, FPngImages.Items[I].Background)
|
|
else begin
|
|
//Basically the same as in the DrawPNG function
|
|
Png.Assign(TPngImageCollectionItem(FPngImages.Items[I]).PngImage);
|
|
if pngBlendOnDisabled in FPngOptions
|
|
then MakeImageBlended(Png);
|
|
if pngGrayscaleOnDisabled in FPngOptions
|
|
then MakeImageGrayscale(Png);
|
|
Icon := PngToIcon(Png);
|
|
end;
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
end;
|
|
finally
|
|
if not FEnabledImages and (FPngOptions <> [])
|
|
then Png.Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TPngImageList.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
if ImageListCount = 0
|
|
then ApplyMethodPatches;
|
|
Inc(ImageListCount);
|
|
FEnabledImages := True;
|
|
FPngOptions := [pngBlendOnDisabled];
|
|
FPngImages := TPngImageCollectionItems.Create(Self);
|
|
FLocked := 0;
|
|
end;
|
|
|
|
destructor TPngImageList.Destroy;
|
|
begin
|
|
FPngImages.Free;
|
|
Dec(ImageListCount);
|
|
if ImageListCount = 0
|
|
then RevertPatchedMethods;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPngImageList.BeginUpdate;
|
|
begin
|
|
Inc(FLocked);
|
|
end;
|
|
|
|
procedure TPngImageList.EndUpdate(Update: Boolean);
|
|
begin
|
|
Dec(FLocked);
|
|
if Update and (FLocked = 0)
|
|
then CopyPngs;
|
|
end;
|
|
|
|
procedure TPngImageList.InsertPng(Index: Integer; const Png: TPNGObject; Background: TColor);
|
|
var
|
|
I: Integer;
|
|
Icon: HICON;
|
|
TempList: TCustomImageList;
|
|
begin
|
|
TempList := TCustomImageList.Create(nil);
|
|
try
|
|
TempList.Assign(Self);
|
|
ImageList_RemoveAll(Handle);
|
|
for I := 0 to Index - 1
|
|
do begin
|
|
Icon := ImageList_GetIcon(TempList.Handle, I, ILD_NORMAL);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
end;
|
|
Icon := PngToIcon(Png, Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
for I := Index to TempList.Count - 1
|
|
do begin
|
|
Icon := ImageList_GetIcon(TempList.Handle, I, ILD_NORMAL);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
end;
|
|
finally
|
|
TempList.Free;
|
|
end;
|
|
end;
|
|
|
|
//--- Patched methods ---
|
|
|
|
function TPngImageList.Add(Image, Mask: TBitmap): Integer;
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then if Image = nil
|
|
then Result := -1
|
|
else begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Add(True);
|
|
CreatePNG(Image, Mask, Item.FPngImage);
|
|
Result := Item.Index;
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Add');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
Result := TCustomImageList(Self).Add(Image, Mask);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end
|
|
else Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function TPngImageList.AddIcon(Image: TIcon): Integer;
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then if Image = nil
|
|
then Result := -1
|
|
else begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Add(True);
|
|
ConvertToPNG(Image, Item.FPngImage);
|
|
Result := Item.Index;
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('AddIcon');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
Result := TCustomImageList(Self).AddIcon(Image);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end
|
|
else Result := -1;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF COMPILER_7_UP}
|
|
function TPngImageList.AddImage(Value: TCustomImageList; Index: Integer): Integer;
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Add a new PNG based on the image from another imagelist. If this happens to be
|
|
//a PngImageList, the PNG object is simply copied.
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Add(False);
|
|
CopyImageFromImageList(Item.FPngImage, Value, Index);
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
Result := Item.Index;
|
|
Change;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('AddImage');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
Result := TCustomImageList(Self).AddImage(Value, Index);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end
|
|
else Result := -1;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TPngImageList.AddImages(Value: TCustomImageList);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
I: Integer;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
//Copy every image from Value into this imagelist.
|
|
for I := 0 to Value.Count - 1
|
|
do begin
|
|
Item := FPngImages.Add(False);
|
|
CopyImageFromImageList(Item.FPngImage, Value, I);
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
end;
|
|
Change;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('AddImages');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).AddImages(Value);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPngImageList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then if Image = nil
|
|
then Result := -1
|
|
else begin
|
|
BeginUpdate;
|
|
try
|
|
//Add a new PNG based on the image and a colored mask.
|
|
Item := FPngImages.Add(True);
|
|
CreatePNGMasked(Image, MaskColor, Item.FPngImage);
|
|
Result := Item.Index;
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_AddIcon(Handle, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('AddMasked');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
Result := TCustomImageList(Self).AddMasked(Image, MaskColor);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end
|
|
else Result := -1;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.Clear;
|
|
var
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Clear the PngImages collection and the internal imagelist.
|
|
BeginUpdate;
|
|
try
|
|
FPngImages.Clear;
|
|
ImageList_Remove(Handle, -1);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Clear');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).Clear;
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.Delete(Index: Integer);
|
|
var
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Delete an image from the PngImages collection and from the internal imagelist.
|
|
if (Index >= 0) and (Index < Count)
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
FPngImages.Delete(Index);
|
|
ImageList_Remove(Handle, Index);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Delete');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).Delete(Index);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.Insert(Index: Integer; Image, Mask: TBitmap);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Insert a new PNG based on the image and its mask.
|
|
if Image <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Insert(Index, True);
|
|
CreatePNG(Image, Mask, Item.FPngImage);
|
|
InsertPng(Index, Item.PngImage, Item.Background);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Insert');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).Insert(Index, Image, Mask);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.InsertIcon(Index: Integer; Image: TIcon);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Insert a new PNG based on the image.
|
|
if Image <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Insert(Index, True);
|
|
ConvertToPNG(Image, Item.FPngImage);
|
|
InsertPng(Index, Item.PngImage, Item.Background);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('InsertIcon');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).InsertIcon(Index, Image);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Insert a new PNG based on the image and a colored mask.
|
|
if Image <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages.Insert(Index, True);
|
|
CreatePNGMasked(Image, MaskColor, Item.FPngImage);
|
|
InsertPng(Index, Item.PngImage, Item.Background);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('InsertMasked');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).InsertMasked(Index, Image, MaskColor);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.Move(CurIndex, NewIndex: Integer);
|
|
var
|
|
Patch: TMethodPatch;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Move an image from one position to another. Don't try doing so in the internal
|
|
//imagelist, just recreate it, since this method won't be called very often.
|
|
BeginUpdate;
|
|
try
|
|
ImageList_Remove(Handle, CurIndex);
|
|
InsertPng(NewIndex, FPngImages[CurIndex].PngImage, FPngImages[CurIndex].Background);
|
|
FPngImages[CurIndex].Index := NewIndex;
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Move');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).Move(CurIndex, NewIndex);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.Replace(Index: Integer; Image, Mask: TBitmap);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Replace an existing PNG based with a new image and its mask.
|
|
if Image <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages[Index];
|
|
Item.FPngImage.Free;
|
|
CreatePNG(Image, Mask, Item.FPngImage);
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_ReplaceIcon(Handle, Index, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('Replace');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).Replace(Index, Image, Mask);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.ReplaceIcon(Index: Integer; Image: TIcon);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Replace an existing PNG based with a new image.
|
|
if Image <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages[Index];
|
|
Item.FPngImage.Free;
|
|
ConvertToPNG(Image, Item.FPngImage);
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_ReplaceIcon(Handle, Index, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('ReplaceIcon');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).ReplaceIcon(Index, Image);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
|
|
var
|
|
Item: TPngImageCollectionItem;
|
|
Patch: TMethodPatch;
|
|
Icon: HICON;
|
|
begin
|
|
if TObject(Self) is TPngImageList
|
|
then begin
|
|
//Replace an existing PNG based with a new image and a colored mask.
|
|
if NewImage <> nil
|
|
then begin
|
|
BeginUpdate;
|
|
try
|
|
Item := FPngImages[Index];
|
|
Item.FPngImage.Free;
|
|
CreatePNGMasked(NewImage, MaskColor, Item.FPngImage);
|
|
Icon := PngToIcon(Item.PngImage, Item.Background);
|
|
ImageList_ReplaceIcon(Handle, Index, Icon);
|
|
DestroyIcon(Icon);
|
|
Change;
|
|
finally
|
|
EndUpdate(False);
|
|
end;
|
|
end
|
|
end
|
|
else begin
|
|
Patch := FindMethodPatch('ReplaceMasked');
|
|
if Patch <> nil
|
|
then begin
|
|
Patch.BeginInvokeOldMethod;
|
|
try
|
|
TCustomImageList(Self).ReplaceMasked(Index, NewImage, MaskColor);
|
|
finally
|
|
Patch.FinishInvokeOldMethod;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//--- End of patched methods ---
|
|
|
|
procedure TPngImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
|
|
var
|
|
PaintRect: TRect;
|
|
Options: TPngOptions;
|
|
Png: TPngImageCollectionItem;
|
|
begin
|
|
//Draw a PNG directly to the Canvas. This is the preferred method to call,
|
|
//because this omits the API calls that use a fixed background.
|
|
PaintRect := Rect(X, Y, X + Width, Y + Height);
|
|
if Enabled
|
|
then Options := []
|
|
else Options := FPngOptions;
|
|
Png := TPngImageCollectionItem(FPngImages.Items[Index]);
|
|
if Png <> nil
|
|
then DrawPNG(Png.PngImage, Canvas, PaintRect, Options);
|
|
end;
|
|
|
|
procedure TPngImageList.SetPngImages(const Value: TPngImageCollectionItems);
|
|
begin
|
|
if FPngImages <> Value
|
|
then begin
|
|
FPngImages.Assign(Value);
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF COMPILER_7_UP}
|
|
|
|
procedure TPngImageList.ReadData(Stream: TStream);
|
|
begin
|
|
//Make sure nothing gets read from the DFM
|
|
end;
|
|
|
|
procedure TPngImageList.WriteData(Stream: TStream);
|
|
begin
|
|
//Make sure nothing gets written to the DFM
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
procedure TPngImageList.DefineProperties(Filer: TFiler);
|
|
var
|
|
Ancestor: TComponent;
|
|
Info: Longint;
|
|
begin
|
|
//Omit defining the bitmap data, and implement the standard properties for
|
|
//TComponent
|
|
Info := 0;
|
|
Ancestor := TComponent(Filer.Ancestor);
|
|
if Ancestor <> nil
|
|
then Info := Ancestor.DesignInfo;
|
|
Filer.DefineProperty('Left', ReadLeft, WriteLeft, LongRec(DesignInfo).Lo <> LongRec(Info).Lo);
|
|
Filer.DefineProperty('Top', ReadTop, WriteTop, LongRec(DesignInfo).Hi <> LongRec(Info).Hi);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TPngImageList.SetEnabledImages(const Value: Boolean);
|
|
begin
|
|
if FEnabledImages xor Value
|
|
then begin
|
|
FEnabledImages := Value;
|
|
CopyPngs;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.SetPngOptions(const Value: TPngOptions);
|
|
begin
|
|
if FPngOptions <> Value
|
|
then begin
|
|
FPngOptions := Value;
|
|
CopyPngs;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF COMPILER_7_UP}
|
|
|
|
procedure TPngImageList.ReadLeft(Reader: TReader);
|
|
var
|
|
FDesignInfo: Longint;
|
|
begin
|
|
FDesignInfo := DesignInfo;
|
|
LongRec(FDesignInfo).Lo := Reader.ReadInteger;
|
|
DesignInfo := FDesignInfo;
|
|
end;
|
|
|
|
procedure TPngImageList.ReadTop(Reader: TReader);
|
|
var
|
|
FDesignInfo: Longint;
|
|
begin
|
|
FDesignInfo := DesignInfo;
|
|
LongRec(FDesignInfo).Hi := Reader.ReadInteger;
|
|
DesignInfo := FDesignInfo;
|
|
end;
|
|
|
|
procedure TPngImageList.WriteLeft(Writer: TWriter);
|
|
begin
|
|
Writer.WriteInteger(LongRec(DesignInfo).Lo);
|
|
end;
|
|
|
|
procedure TPngImageList.WriteTop(Writer: TWriter);
|
|
begin
|
|
Writer.WriteInteger(LongRec(DesignInfo).Hi);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function TPngImageList.GetHeight: Integer;
|
|
begin
|
|
Result := inherited Height;
|
|
end;
|
|
|
|
function TPngImageList.GetWidth: Integer;
|
|
begin
|
|
Result := inherited Width;
|
|
end;
|
|
|
|
procedure TPngImageList.SetHeight(const Value: Integer);
|
|
begin
|
|
if inherited Height <> Value
|
|
then begin
|
|
inherited Height := Value;
|
|
Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngImageList.SetWidth(const Value: Integer);
|
|
begin
|
|
if inherited Width <> Value
|
|
then begin
|
|
inherited Width := Value;
|
|
Clear;
|
|
end;
|
|
end;
|
|
|
|
{ TPngImageCollection }
|
|
|
|
constructor TPngImageCollection.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FItems := TPngImageCollectionItems.Create(Self);
|
|
end;
|
|
|
|
destructor TPngImageCollection.Destroy;
|
|
begin
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TPngImageCollectionItems }
|
|
|
|
constructor TPngImageCollectionItems.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(TPngImageCollectionItem);
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TPngImageCollectionItems.Add(DontCreatePNG: Boolean = False): TPngImageCollectionItem;
|
|
begin
|
|
{$IFDEF COMPILER_6_UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
|
|
Result := TPngImageCollectionItem.Create(Self, DontCreatePNG);
|
|
{$IFDEF COMPILER_6_UP}Added(TCollectionItem(Result));{$ENDIF}
|
|
end;
|
|
|
|
function TPngImageCollectionItems.Insert(Index: Integer; DontCreatePNG: Boolean = False): TPngImageCollectionItem;
|
|
begin
|
|
Result := Add(DontCreatePNG);
|
|
Result.Index := Index;
|
|
end;
|
|
|
|
procedure TPngImageCollectionItems.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
Update(nil);
|
|
end;
|
|
|
|
function TPngImageCollectionItems.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
procedure TPngImageCollectionItems.Update(Item: TCollectionItem);
|
|
begin
|
|
inherited Update(Item);
|
|
if FOwner is TPngImageList
|
|
then TPngImageList(FOwner).CopyPngs;
|
|
end;
|
|
|
|
function TPngImageCollectionItems.GetItem(Index: Integer): TPngImageCollectionItem;
|
|
begin
|
|
if (Index >= 0) and (Index < Count)
|
|
then Result := TPngImageCollectionItem(inherited Items[Index])
|
|
else Result := nil;
|
|
end;
|
|
|
|
procedure TPngImageCollectionItems.SetItem(Index: Integer; const Value: TPngImageCollectionItem);
|
|
begin
|
|
if (Index >= 0) and (Index < Count)
|
|
then inherited Items[Index] := Value;
|
|
end;
|
|
|
|
{ TPngImageCollectionItem }
|
|
|
|
procedure TPngImageCollectionItem.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited AssignTo(Dest);
|
|
if (Dest is TPngImageCollectionItem)
|
|
then TPngImageCollectionItem(Dest).PngImage := PngImage;
|
|
end;
|
|
|
|
constructor TPngImageCollectionItem.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
FPngImage := TPNGObject.Create;
|
|
FName := Format('PngImage%d', [Index]);
|
|
FBackground := clBtnFace;
|
|
end;
|
|
|
|
constructor TPngImageCollectionItem.Create(Collection: TCollection; DontCreatePNG: Boolean = False);
|
|
begin
|
|
inherited Create(Collection);
|
|
if DontCreatePng
|
|
then FPngImage := nil
|
|
else FPngImage := TPNGObject.Create;
|
|
FName := Format('PngImage%d', [Index]);
|
|
FBackground := clBtnFace;
|
|
end;
|
|
|
|
destructor TPngImageCollectionItem.Destroy;
|
|
begin
|
|
FPngImage.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPngImageCollectionItem.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TPngImageCollectionItem
|
|
then begin
|
|
PngImage.Assign(TPngImageCollectionItem(Source).PngImage);
|
|
Background := TPngImageCollectionItem(Source).Background;
|
|
Name := TPngImageCollectionItem(Source).Name;
|
|
end
|
|
else inherited Assign(Source);
|
|
end;
|
|
|
|
function TPngImageCollectionItem.Duplicate: TPNGObject;
|
|
begin
|
|
Result := TPNGObject.Create;
|
|
Result.Assign(FPngImage);
|
|
end;
|
|
|
|
function TPngImageCollectionItem.GetDisplayName: string;
|
|
begin
|
|
if Length(FName) = 0
|
|
then Result := inherited GetDisplayName
|
|
else Result := FName;
|
|
end;
|
|
|
|
procedure TPngImageCollectionItem.SetPngImage(const Value: TPNGObject);
|
|
begin
|
|
FPngImage.Assign(Value);
|
|
Changed(False);
|
|
end;
|
|
|
|
procedure TPngImageCollectionItem.SetBackground(const Value: TColor);
|
|
begin
|
|
if FBackground <> Value
|
|
then begin
|
|
FBackground := Value;
|
|
Changed(False);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
finalization
|
|
MethodPatches.Free;
|
|
|
|
end.
|