关于资源图片文件与DLL到Imagelist

unit udmImage;

interface

uses
  Windows, SysUtils, Classes, ImgList, Controls, Graphics;

type
  TdmImage = class(TDataModule)
    ImgLst16: TImageList;
    procedure DataModuleCreate(Sender: TObject);
  private
    {装载16×16的图标资源}
    procedure LoadIcon16;
  public

  end;

var
  dmImage: TdmImage;

implementation

{$R *.dfm}

procedure EnumResNamesProc(AMod: HModule; ResType: PChar; ResName: PChar; List: TStrings); stdcall;
begin
  List.Add(ResName);
end;

const
  sDllName = 'HsIcon16.Dll';
 
procedure TdmImage.LoadIcon16;
var
  Icon: TIcon;
  I: Integer;
  HResDll: THandle;
  List: TStringList;
 
  procedure LoadResIcon(ResName: string);
  var
    Stream: TResourceStream;
  begin
    Stream := TResourceStream.Create(HResDll, ResName, 'BMP');
    try
      Icon.LoadFromStream(Stream);
      ImgLst16.AddIcon(Icon);
    finally
      Stream.Free;
    end;
  end;
 
begin
  HResDll := LoadLibrary(sDllName);
  try
    if HResDll <> 0 then
    begin
      List := TStringList.Create;
      try
        EnumResourceNames(HResDll, 'BMP', @EnumResNamesProc, Integer(List));
        List.Sorted := True;
        Icon := TIcon.Create;
        try
          for I := 0 to List.Count - 1 do LoadResIcon(List[I]);
        finally
          Icon.Free;
        end;
      finally
        List.Free;
      end;
    end;
  finally
    if HResDll <> 0 then FreeLibrary(HResDll);
  end;
end;

procedure TdmImage.DataModuleCreate(Sender: TObject);
begin
  LoadIcon16;
end;

end. 

 

将ImageList的图片保存到本地：

procedure TForm1.Button1Click(Sender: TObject);
var
  spath: string;
begin
  spath := ExtractFilePath(Application.ExeName) + 'imagelist/';
  for i := 0 to ImgLst16.Count - 1 do
  begin
    Image1.Width := ImgLst16.Width;
    Image1.Height := ImgLst16.Height;
    ImgLst16.GetBitmap(i, Image1.Picture.Bitmap);
    Image1.Picture.Bitmap.SaveToFile(spath + IntToStr(i) + '.bmp');
    Image1.Picture.Bitmap := nil;
    Image1.Refresh;
    Image1.Repaint;
    Application.ProcessMessages;

  end;
end;