[Delphi] Sex Icons 0.1

[BigBear]

Un simple programa para buscar y extraer iconos.

Una imagen :



El codigo :

Código (delphi) [Seleccionar] Expandir


// 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