unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm9 = class(TForm)
    lbl1: TLabel;
    txt1: TEdit;
    btn1: TButton;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    procedure btn1Click(Sender: TObject);
  private
    imgArr:array of TImage;
    { Private declarations }
    procedure saveIcon(s:TObject);
  public
    { Public declarations }
  end;

var
  Form9: TForm9;

implementation
uses
  ShellAPI;

{$R *.dfm}

procedure TForm9.btn1Click(Sender: TObject);
var
  num:Integer;
  I: Integer;
begin
  if Length(imgArr)>0 then
    for I := Low(imgArr) to High(imgArr) do
      imgArr[i].Free;

  if dlgOpen1.Execute then
  begin
    txt1.Text:=dlgOpen1.FileName;
    num:=extracticon(HInstance,PChar(dlgOpen1.FileName),$FFFFFFFF);
    if num>0 then
    begin
      SetLength(imgArr,num);
      for I := 0 to num - 1 do
      begin
        imgArr[i]:=TImage.Create(Self);
        imgArr[i].Parent:=Self;
        imgArr[i].Width:=64;
        imgArr[i].Height:=64;
        imgArr[i].Stretch:=True;
        imgArr[i].Left:=5 + (i mod 5)*65;
        imgArr[i].Top:=25 + (i div 5)*65;
        imgArr[i].Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(dlgOpen1.FileName),i);
        imgArr[i].OnClick:= saveIcon;
      end;
    end;
  end;
end;

procedure TForm9.saveIcon(s: TObject);
begin
  if s is TImage then
  begin
    if dlgSave1.Execute() then
      (s as TImage).Picture.SaveToFile(dlgSave1.FileName + '.ico');
  end;
end;

end.