Delphi 擴展 TImageList 實現圖像集合持久化：API 流序列化與自定義格式雙方案

痛點

VCL TImageList 缺乏 SaveToFile/Stream、LoadFromFile/Stream 方法，無法直接將設計時/運行時構建的圖像集合持久化到文件或流中，導致動態換膚、插件圖標管理、配置導出等場景難以實現。

方案一：系統 API 序列化 (ImageList_Write / ImageList_Read)

利用 ComCtl32.dll 導出函數，直接將內核 ImageList 結構序列化為標準流格式。

• 優點：調用簡單、格式由系統定義、兼容性最好 (可跨進程/跨語言交換)。
• 缺點：依賴 IStream 接口，需 TStreamAdapter 適配；格式不透明、難以手工編輯/檢查；舊版 ComCtl32 可能不支持。

uses CommCtrl, ActiveX; // 需引入

procedure SaveToStream_API(ImageList: TImageList; Stream: TStream);
var SA: IStream;
begin
  SA := TStreamAdapter.Create(Stream) as IStream;
  if not ImageList_Write(ImageList.Handle, SA) then RaiseLastOSError;
end;

procedure LoadFromStream_API(ImageList: TImageList; Stream: TStream);
var SA: IStream; NewHandle: HIMAGELIST;
begin
  SA := TStreamAdapter.Create(Stream) as IStream;
  NewHandle := ImageList_Read(SA);
  if NewHandle = 0 then RaiseLastOSError;
  ImageList.Handle := NewHandle; // 替換句柄
end;

方案二：自定義格式 (完全可控、可擴展)

繼承 TImageList → TImageListEx，手動遍歷 GetImages(Index, Image, Mask) 獲取每幀位圖與掩碼，序列化為：頭部(寬/高) + 幀數據(位圖大小+位圖數據+掩碼大小+掩碼數據)...。

• 優點：格式透明、可攜帶元數據 (標簽、分類)、不依賴特定 ComCtl32 版本、易於加密/壓縮。
• 缺點：代碼量大、需自行處理位圖編碼 (用 TBitmap.SaveToStream 內部為 BMP 格式)。

完整組件代碼：TImageListEx

unit ImageListEx;
interface
uses Windows, SysUtils, Classes, Graphics, Controls, CommCtrl, ImgList, Consts;

type
  TImageListEx = class(TImageList)
  public
    // API 方式
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    // 自定義格式方式 (推薦)
    procedure LoadFromFileEx(const FileName: string);
    procedure LoadFromStreamEx(Stream: TStream);
    procedure SaveToFileEx(const FileName: string);
    procedure SaveToStreamEx(Stream: TStream);
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TImageListEx]);
end;

{ TImageListEx - API 方式 }
procedure TImageListEx.LoadFromFile(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try LoadFromStream(Stream); finally Stream.Free; end;
end;

procedure TImageListEx.LoadFromStream(Stream: TStream);
var SA: IStream;
begin
  SA := TStreamAdapter.Create(Stream) as IStream;
  Handle := ImageList_Read(SA);
  if Handle = 0 then raise EReadError.CreateRes(@SImageReadFail);
end;

procedure TImageListEx.SaveToFile(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try SaveToStream(Stream); finally Stream.Free; end;
end;

procedure TImageListEx.SaveToStream(Stream: TStream);
var SA: IStream;
begin
  SA := TStreamAdapter.Create(Stream) as IStream;
  if not ImageList_Write(Handle, SA) then raise EWriteError.CreateRes(@SImageWriteFail);
end;

{ TImageListEx - 自定義格式方式 }
procedure TImageListEx.LoadFromFileEx(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try LoadFromStreamEx(Stream); finally Stream.Free; end;
end;

procedure TImageListEx.LoadFromStreamEx(Stream: TStream);
var Width, Height: Integer; Bitmap, Mask: TBitmap; BinStream: TMemoryStream;
  procedure LoadImageFromStream(Image: TBitmap);
  var Count: DWORD;
  begin
    Image.Assign(nil);
    Stream.ReadBuffer(Count, SizeOf(Count));
    BinStream.Clear; BinStream.CopyFrom(Stream, Count);
    BinStream.Position := 0; Image.LoadFromStream(BinStream);
  end;
begin
  Stream.ReadBuffer(Height, SizeOf(Height));
  Stream.ReadBuffer(Width, SizeOf(Width));
  Self.Height := Height; Self.Width := Width;
  Bitmap := TBitmap.Create; Mask := TBitmap.Create; BinStream := TMemoryStream.Create;
  try
    while Stream.Position < Stream.Size do
    begin
      LoadImageFromStream(Bitmap); LoadImageFromStream(Mask);
      Add(Bitmap, Mask);
    end;
  finally Bitmap.Free; Mask.Free; BinStream.Free; end;
end;

procedure TImageListEx.SaveToFileEx(const FileName: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try SaveToStreamEx(Stream); finally Stream.Free; end;
end;

procedure TImageListEx.SaveToStreamEx(Stream: TStream);
var I: Integer; Width, Height: Integer; Bitmap, Mask: TBitmap; BinStream: TMemoryStream;
  procedure SetImage(Image: TBitmap; IsMask: Boolean);
  begin
    Image.Assign(nil);
    if IsMask then Image.Monochrome := True;
    Image.Height := Self.Height; Image.Width := Self.Width;
  end;
  procedure SaveImageToStream(Image: TBitmap);
  var Count: DWORD;
  begin
    BinStream.Clear; Image.SaveToStream(BinStream);
    Count := BinStream.Size;
    Stream.WriteBuffer(Count, SizeOf(Count));
    Stream.CopyFrom(BinStream, 0);
  end;
begin
  Stream.WriteBuffer(Self.Height, SizeOf(Self.Height));
  Stream.WriteBuffer(Self.Width, SizeOf(Self.Width));
  Bitmap := TBitmap.Create; Mask := TBitmap.Create; BinStream := TMemoryStream.Create;
  try
    for I := 0 to Count - 1 do
    begin
      SetImage(Bitmap, False); SetImage(Mask, True);
      GetImages(I, Bitmap, Mask); // 關鍵：從基類 Protected 方法獲取 Image+Mask
      SaveImageToStream(Bitmap); SaveImageToStream(Mask);
    end;
  finally Bitmap.Free; Mask.Free; BinStream.Free; end;
end;

end.

測試用例

1. Form 放 TImageListEx、TTreeView (關聯 Images)、4 個 Button。
2. ImageListEx 添加幾個圖標，TreeView 節點設置 ImageIndex。
3. Button1: ImageListEx1.SaveToFile('C:\CJ.dat'); ImageListEx1.SaveToFileEx('C:\CJEx.dat');
4. Button2: ImageListEx1.Clear; (清空驗證)
5. Button3: ImageListEx1.LoadFromFile('C:\CJ.dat'); (API 方式恢復)
6. Button4: ImageListEx1.LoadFromFileEx('C:\CJEx.dat'); (自定義格式恢復)
7. 運行：點 Button1 → Button2 (圖標消失) → Button3 或 Button4 (圖標恢復，TreeView 正常顯示)。

方案選擇建議

總結

通過繼承 TImageList 並封裝 ImageList_Write/Read API 或實現自定義 BMP 序列化，成功彌補了 VCL 圖像列表持久化的缺失。TImageListEx 組件可直接安裝到組件面板，為動態圖標管理、主題切換、插件系統提供核心基礎設施。