unit NamedImageList;

interface

uses
  System.Classes, System.Generics.Collections, System.SysUtils, Vcl.Controls,
  Vcl.ImgList, Vcl.Graphics, Vcl.Imaging.pngimage, Winapi.Windows;

type
  TNamedImageList = class(Vcl.Controls.TImageList)
  private
    FNameIndexMap: TDictionary<string, Integer>;
    function GetImageName(Index: Integer): string;
    procedure SetImageName(Index: Integer; const Value: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(Bitmap: Vcl.Graphics.TBitmap; const ImageName: string): Integer; reintroduce; overload;
    function AddPNG(PNG: TPngImage; const ImageName: string): Integer;
    function IndexOfName(const ImageName: string): Integer;
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
    property ImageName[Index: Integer]: string read GetImageName write SetImageName;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PA-Soft', [TNamedImageList]);
end;

{ TNamedImageList }

constructor TNamedImageList.Create(AOwner: TComponent);
begin
  inherited;
  FNameIndexMap := TDictionary<string, Integer>.Create;
  // Set properties for best quality with transparency
  ColorDepth := cd32Bit;
  DrawingStyle := dsTransparent;
end;

destructor TNamedImageList.Destroy;
begin
  FNameIndexMap.Free;
  inherited;
end;

function TNamedImageList.Add(Bitmap: Vcl.Graphics.TBitmap; const ImageName: string): Integer;
begin
  Result := inherited Add(Bitmap, nil);
  if Result >= 0 then
  begin
    if FNameIndexMap.ContainsKey(ImageName) then
      FNameIndexMap[ImageName] := Result
    else
      FNameIndexMap.Add(ImageName, Result);
  end;
end;

function TNamedImageList.AddPNG(PNG: TPngImage; const ImageName: string): Integer;
var
  Bitmap: Vcl.Graphics.TBitmap;
  x, y: Integer;
  BmpLine: PRGBQuad;
  AlphaLine: pByteArray;
  PngColor: TColor;
  R, G, B: Byte;
begin
  Bitmap := Vcl.Graphics.TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.AlphaFormat := afDefined;
    Bitmap.SetSize(PNG.Width, PNG.Height);

    // Manually copy pixels with alpha channel
    for y := 0 to PNG.Height - 1 do
    begin
      BmpLine := Bitmap.ScanLine[y];

      for x := 0 to PNG.Width - 1 do
      begin
        // Get RGB from PNG
        PngColor := PNG.Pixels[x, y];
        R := GetRValue(PngColor);
        G := GetGValue(PngColor);
        B := GetBValue(PngColor);

        BmpLine^.rgbRed := R;
        BmpLine^.rgbGreen := G;
        BmpLine^.rgbBlue := B;

        // Get Alpha from PNG
        if Assigned(PNG.AlphaScanline[y]) then
        begin
          AlphaLine := PNG.AlphaScanline[y];
          BmpLine^.rgbReserved := AlphaLine[x];
        end
        else
          BmpLine^.rgbReserved := 255; // Fully opaque if no alpha channel

        Inc(BmpLine);
      end;
    end;

    Result := inherited Add(Bitmap, nil);
    if Result >= 0 then
    begin
      if FNameIndexMap.ContainsKey(ImageName) then
        FNameIndexMap[ImageName] := Result
      else
        FNameIndexMap.Add(ImageName, Result);
    end;
  finally
    Bitmap.Free;
  end;
end;

function TNamedImageList.GetImageName(Index: Integer): string;
var
  Pair: TPair<string, Integer>;
begin
  Result := '';
  for Pair in FNameIndexMap do
    if Pair.Value = Index then
    begin
      Result := Pair.Key;
      Break;
    end;
end;

procedure TNamedImageList.SetImageName(Index: Integer; const Value: string);
var
  OldName: string;
begin
  OldName := GetImageName(Index);
  if OldName <> '' then
    FNameIndexMap.Remove(OldName);
  if Value <> '' then
    FNameIndexMap.AddOrSetValue(Value, Index);
end;

function TNamedImageList.IndexOfName(const ImageName: string): Integer;
begin
  if not FNameIndexMap.TryGetValue(ImageName, Result) then
    Result := -1;
end;

procedure TNamedImageList.SaveToFile(const FileName: string);
var
  FS: TFileStream;
  MS: TMemoryStream;
  PNG: TPngImage;
  TempBitmap: Vcl.Graphics.TBitmap;
  I, StrLen, DataSize: Integer;
  Name: string;
  x, y: Integer;
  BmpLine: PRGBQuad;
  AlphaLine: pByteArray;
begin
  FS := TFileStream.Create(FileName, fmCreate);
  try
    // Write count
    I := Count;
    FS.WriteBuffer(I, SizeOf(Integer));

    TempBitmap := Vcl.Graphics.TBitmap.Create;
    PNG := TPngImage.Create;
    MS := TMemoryStream.Create;
    try
      for I := 0 to Count - 1 do
      begin
        // Write name (length-prefixed)
        Name := GetImageName(I);
        StrLen := Length(Name);
        FS.WriteBuffer(StrLen, SizeOf(Integer));
        if StrLen > 0 then
          FS.WriteBuffer(PChar(Name)^, StrLen * SizeOf(Char));

        // Get bitmap from ImageList
        TempBitmap.PixelFormat := pf32bit;
        TempBitmap.AlphaFormat := afDefined;
        GetBitmap(I, TempBitmap);

        // Convert bitmap to PNG with alpha channel
        PNG.Assign(TempBitmap);

        // Ensure PNG has alpha channel
        if not Assigned(PNG.AlphaScanline[0]) then
          PNG.CreateAlpha;

        // Copy alpha channel from bitmap to PNG
        for y := 0 to TempBitmap.Height - 1 do
        begin
          BmpLine := TempBitmap.ScanLine[y];
          AlphaLine := PNG.AlphaScanline[y];

          for x := 0 to TempBitmap.Width - 1 do
          begin
            AlphaLine[x] := BmpLine^.rgbReserved;
            Inc(BmpLine);
          end;
        end;

        MS.Clear;
        PNG.SaveToStream(MS);

        DataSize := MS.Size;
        FS.WriteBuffer(DataSize, SizeOf(Integer));
        if DataSize > 0 then
          FS.CopyFrom(MS, 0);
      end;
    finally
      MS.Free;
      PNG.Free;
      TempBitmap.Free;
    end;
  finally
    FS.Free;
  end;
end;

procedure TNamedImageList.LoadFromFile(const FileName: string);
var
  FS: TFileStream;
  MS: TMemoryStream;
  PNG: TPngImage;
  I, Count, StrLen, DataSize: Integer;
  Name: string;
begin
  if not FileExists(FileName) then
    raise EFileNotFoundException.Create('File not found: ' + FileName);

  Clear;
  FNameIndexMap.Clear;

  FS := TFileStream.Create(FileName, fmOpenRead);
  try
    // Read count
    FS.ReadBuffer(Count, SizeOf(Integer));

    PNG := TPngImage.Create;
    MS := TMemoryStream.Create;
    try
      for I := 0 to Count - 1 do
      begin
        // Read name (length-prefixed)
        FS.ReadBuffer(StrLen, SizeOf(Integer));
        SetLength(Name, StrLen);
        if StrLen > 0 then
          FS.ReadBuffer(PChar(Name)^, StrLen * SizeOf(Char));

        // Read PNG data
        FS.ReadBuffer(DataSize, SizeOf(Integer));
        MS.Clear;
        if DataSize > 0 then
        begin
          MS.CopyFrom(FS, DataSize);
          MS.Position := 0;
          PNG.LoadFromStream(MS);

          // Add PNG with proper alpha channel handling
          AddPNG(PNG, Name);
        end;
      end;
    finally
      MS.Free;
      PNG.Free;
    end;
  finally
    FS.Free;
  end;
end;

end.

NamedImageListFavIcons.LoadFromFile('FavIconsNamedImageList.dat');
  CodeSite.Send('NamedImageListFavIcons.Count', NamedImageListFavIcons.Count); // 127

  var GoogleComIndex := NamedImageListFavIcons.IndexOfName('google.com');
  CodeSite.Send('GoogleComIndex', GoogleComIndex); // 7

  var ThisBitmap := TBitmap.Create;
  try
    NamedImageListFavIcons.GetBitmap(GoogleComIndex, ThisBitmap);
    CodeSite.Send('google.com icon', ThisBitmap);
  finally
    ThisBitmap.Free;
  end;

  // Add all bitmaps of a TIEMultiBitmap to a TImageList
  mbmp := TIEMultiBitmap.Create();
  mbmp.LoadSnapshot( ... );
  for i := 0 to mbmp.Count - 1 do
  begin
    bmp := mbmp.GetTIEBitmap( i );
    bmp.AddToImageList( myImageList );
    mbmp.ReleaseBitmap( i, False );
  end;
  mbmp.Free();