226
Delphi / [Delphi] Sex Icons 0.1
« en: Agosto 09, 2013, 06:00:52 pm »
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: Delphi
- // 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