geticon.pas

特别方便的工具程序

unit GetIcon;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  CommCtrl, ShellAPI, Dialogs, ImgList, ComCtrls, StdCtrls, ExtCtrls;

type
  TIconForm3 = class(TForm)
    List2: TImageList;
    List1: TListView;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    GroupBox1: TGroupBox;
    Image1: TImage;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure List1Data(Sender: TObject; Item: TListItem);
    procedure LoadFileIcon(Sender: TObject);
    procedure LoadDefIcon(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  IconForm3: TIconForm3;

implementation

{$R *.dfm}

procedure TIconForm3.FormCreate(Sender: TObject);
var
  FileInfo: TSHFileInfo;
  ImageListHandle: THandle;
  i: integer;
begin
  List1.Clear;
  ImageListHandle := SHGetFileInfo('C:\',
    0, FileInfo, SizeOf(FileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

  SendMessage(List1.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
  for i := 0 to 200 do with List1.Items.Add do begin
      Caption := 'File' + IntToStr(I);
      ImageIndex := i;
    end;
end;


procedure TIconForm3.List1Data(Sender: TObject; Item: TListItem);
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  Flags := {SHGFI_PIDL or } SHGFI_SYSICONINDEX or SHGFI_ICON;
  SHGetFileInfo('C:\*.bat',
    SHGFI_USEFILEATTRIBUTES,
    FileInfo,
    SizeOf(FileInfo),
    Flags);
{  SHGetFileInfo('', SHGFI_USEFILEATTRIBUTES or SHGFI_ICON,
    FileInfo, SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
}
  Item.ImageIndex := FileInfo.iIcon;
  Item.Caption := inttostr(FileInfo.iIcon);
  Caption := Item.Caption
  //Item.ImageIndex := 1;
end;

procedure TIconForm3.LoadFileIcon(Sender: TObject);
var
  IconIndex: word;
  h: hIcon;
begin
  IconIndex := 0;
  h := ExtractAssociatedIcon(hInstance, PChar('D:\*.zip'), IconINdex);
  //这个函数返回的是一个handle
  DrawIcon(image1.Canvas.Handle, 0, 0, h);
end;

procedure TIconForm3.LoadDefIcon(Sender: TObject);
var
  LibHandle: HINST;
  Icon: HICon;
  AAA: PChar;
begin
  LibHandle := LoadLibrary('C:\Windows\System\Shell32.dll'); // 需要取图标的资源文件名
  if LibHandle = 0 then begin
    MessageBox(0, PChar(SysErrorMessage(GetLastError)), 'Error', MB_OK);
    FreeLibrary(LibHandle);
    exit;
  end;
  ICON := HICON(LoadImage(LibHandle, MakeIntResource(151), IMAGE_ICON, 0, 0, 0));
  //151: 图标资源序号
  Image1.Picture.Icon.Handle := ICON; // 放到一个 Image 控件中
  Image1.Picture.Icon.SaveToFile('C:\Temp\1001.ico');

  FreeLibrary(LibHandle);
end;

end.