Un simple programa para buscar y extraer iconos.
Una imagen :
![]()
El codigo :
Si quieren bajarlo lo pueden hacer de aca
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 ?