elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Trabajando con las ramas de git (tercera parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  [Delphi] Sex Icons 0.1
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Delphi] Sex Icons 0.1  (Leído 1,522 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Delphi] Sex Icons 0.1
« en: 9 Agosto 2013, 17:59 pm »

Un simple programa para buscar y extraer iconos.

Una imagen :



El codigo :

Código
  1. // Sex Icons 0.1
  2. // Coded By Doddy H
  3.  
  4. unit sex;
  5.  
  6. interface
  7.  
  8. uses
  9.  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.  Dialogs, jpeg, ExtCtrls, ComCtrls, StdCtrls, ShellAPI, ImgList;
  11.  
  12. type
  13.  TForm1 = class(TForm)
  14.    Image1: TImage;
  15.    GroupBox1: TGroupBox;
  16.    Label1: TLabel;
  17.    Edit1: TEdit;
  18.    ListView1: TListView;
  19.    Button1: TButton;
  20.    GroupBox2: TGroupBox;
  21.    Button2: TButton;
  22.    ImageList1: TImageList;
  23.    GroupBox3: TGroupBox;
  24.    Image2: TImage;
  25.  
  26.    Image3: TImage;
  27.    SaveDialog1: TSaveDialog;
  28.    procedure Button1Click(Sender: TObject);
  29.    procedure ListView1DblClick(Sender: TObject);
  30.    procedure Button2Click(Sender: TObject);
  31.    procedure FormCreate(Sender: TObject);
  32.  private
  33.    { Private declarations }
  34.  public
  35.    { Public declarations }
  36.  end;
  37.  
  38. var
  39.  Form1: TForm1;
  40.  
  41. implementation
  42.  
  43. {$R *.dfm}
  44.  
  45. procedure TForm1.Button1Click(Sender: TObject);
  46. var
  47.  buscar: TSearchRec;
  48.  Icon: TIcon;
  49.  listate: TListItem;
  50.  getdata: SHFILEINFO;
  51.  dirnow: string;
  52.  
  53. begin
  54.  
  55.  dirnow := Edit1.Text;
  56.  
  57.  ListView1.Items.Clear;
  58.  Icon := TIcon.Create;
  59.  ListView1.Items.BeginUpdate;
  60.  
  61.  if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
  62.  begin
  63.    repeat
  64.      if (buscar.Attr <> faDirectory) then
  65.      begin
  66.  
  67.        with ListView1 do
  68.        begin
  69.  
  70.          listate := ListView1.Items.Add;
  71.  
  72.          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  73.              , SHGFI_DISPLAYNAME);
  74.          listate.Caption := buscar.Name;
  75.  
  76.          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  77.              , SHGFI_TYPENAME);
  78.          listate.SubItems.Add(getdata.szTypeName);
  79.  
  80.          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  81.              , SHGFI_ICON or SHGFI_SMALLICON);
  82.          Icon.Handle := getdata.hIcon;
  83.          listate.ImageIndex := ImageList1.AddIcon(Icon);
  84.  
  85.          DestroyIcon(getdata.hIcon);
  86.  
  87.        end;
  88.  
  89.      end
  90.  
  91.      until FindNext(buscar) <> 0;
  92.      FindClose(buscar);
  93.    end;
  94.  
  95.    ListView1.Items.EndUpdate;
  96.  
  97.  end;
  98.  
  99.  procedure TForm1.Button2Click(Sender: TObject);
  100.  begin
  101.  
  102.    if SaveDialog1.Execute then
  103.    begin
  104.      Image2.Picture.Icon.SaveToFile(SaveDialog1.FileName);
  105.      ShowMessage('Icon Extracted');
  106.    end;
  107.  
  108.  end;
  109.  
  110.  procedure TForm1.FormCreate(Sender: TObject);
  111.  begin
  112.  
  113.    SaveDialog1.Title := 'Save your Icon';
  114.    SaveDialog1.InitialDir := GetCurrentDir;
  115.    SaveDialog1.DefaultExt := 'ico';
  116.  
  117.  end;
  118.  
  119.  procedure TForm1.ListView1DblClick(Sender: TObject);
  120.  
  121.  var
  122.    acanow: TIcon;
  123.    archivo: string;
  124.    bajar: TSHFileInfo;
  125.  
  126.  begin
  127.  
  128.    archivo := Edit1.Text + ListView1.Selected.Caption;
  129.    if FileExists(archivo) then
  130.    begin
  131.      acanow := TIcon.Create;
  132.      SHGetFileInfo(PChar(archivo), 0, bajar, SizeOf(bajar), SHGFI_ICON);
  133.      acanow.Handle := bajar.hIcon;
  134.      Image2.Picture.Icon := acanow;
  135.      acanow.Free;
  136.    end;
  137.  end;
  138.  
  139. end.
  140.  
  141. // The End ?
  142.  

Si quieren bajarlo lo pueden hacer de aca


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Macromedia Studio 8 Dock Icons
Diseño Gráfico
aNexos 0 1,813 Último mensaje 19 Marzo 2006, 07:30 am
por aNexos
[Descarga] CodeGear RAD Studio - Delphi 2007 + Delphi for PHP « 1 2 3 »
Software
GroK 26 26,833 Último mensaje 14 Mayo 2014, 17:51 pm
por sebaseok
Mozilla presenta los Privacy Icons
Noticias
wolfbcn 0 1,532 Último mensaje 27 Diciembre 2010, 18:07 pm
por wolfbcn
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines