comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] Sex Icons 0.1

  • 1 Respuestas
  • 1690 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Agosto 09, 2013, 12:59:12 pm »
Un simple programa para buscar y extraer iconos.

Una imagen :



El codigo :

Código: Delphi
  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 No tienes permisos para ver links. Registrate o Entra con tu cuenta

Desconectado Stiuvert

  • *
  • Colaborador
  • *
  • Mensajes: 2668
  • Actividad:
    1.67%
  • Reputación 14
    • Ver Perfil
  • Skype: stiuvert@gmail.com
  • Twitter: @Stiuvert
« Respuesta #1 en: Agosto 09, 2013, 05:11:16 pm »
Muy buen aporte!

Lo checaré, me vendrá fenomenal ;)


Saludos

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1985
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3131
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3263
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1415
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2577
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear