Una imagen :
El codigo :
Código
// Sex Icons 0.1 // Coded By Doddy H unit sex; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, jpeg, ExtCtrls, ComCtrls, StdCtrls, ShellAPI, ImgList; type TForm1 = class(TForm) Image1: TImage; GroupBox1: TGroupBox; Label1: TLabel; Edit1: TEdit; ListView1: TListView; Button1: TButton; GroupBox2: TGroupBox; Button2: TButton; ImageList1: TImageList; GroupBox3: TGroupBox; Image2: TImage; Image3: TImage; SaveDialog1: TSaveDialog; procedure Button1Click(Sender: TObject); procedure ListView1DblClick(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var buscar: TSearchRec; Icon: TIcon; listate: TListItem; getdata: SHFILEINFO; dirnow: string; begin dirnow := Edit1.Text; ListView1.Items.Clear; Icon := TIcon.Create; ListView1.Items.BeginUpdate; if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then begin repeat if (buscar.Attr <> faDirectory) then begin with ListView1 do begin listate := ListView1.Items.Add; SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata) , SHGFI_DISPLAYNAME); listate.Caption := buscar.Name; SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata) , SHGFI_TYPENAME); listate.SubItems.Add(getdata.szTypeName); SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata) , SHGFI_ICON or SHGFI_SMALLICON); Icon.Handle := getdata.hIcon; listate.ImageIndex := ImageList1.AddIcon(Icon); DestroyIcon(getdata.hIcon); end; end until FindNext(buscar) <> 0; FindClose(buscar); end; ListView1.Items.EndUpdate; end; procedure TForm1.Button2Click(Sender: TObject); begin if SaveDialog1.Execute then begin Image2.Picture.Icon.SaveToFile(SaveDialog1.FileName); ShowMessage('Icon Extracted'); end; end; procedure TForm1.FormCreate(Sender: TObject); begin SaveDialog1.Title := 'Save your Icon'; SaveDialog1.InitialDir := GetCurrentDir; SaveDialog1.DefaultExt := 'ico'; end; procedure TForm1.ListView1DblClick(Sender: TObject); var acanow: TIcon; archivo: string; bajar: TSHFileInfo; begin archivo := Edit1.Text + ListView1.Selected.Caption; if FileExists(archivo) then begin acanow := TIcon.Create; SHGetFileInfo(PChar(archivo), 0, bajar, SizeOf(bajar), SHGFI_ICON); acanow.Handle := bajar.hIcon; Image2.Picture.Icon := acanow; acanow.Free; end; end; end. // The End ?
Si quieren bajarlo lo pueden hacer de aca