iconos de carpeta
 

hola a todos :):):):)

quisiera saber si hay una manera de personalizar el icono de una carpeta atravez de una aplicacion en delphi, algo mas o menos asi

Código Delphi [-]
var
cad1,cad2: string

begin
cad1:='ubicación de carpeta;
cad2:='ubicación del icono;
cambiaricono(cad1, cad2);
end

gracias por la ayuda brindada de antemano:D

Creo que lo que estas buscando es algo como la personalización de una carpeta no? en tal caso deberías usar la escritura de un archivo de "texto", pues la información que lee la Shell viene de un archivo Desktop.ini con atributos HS en la carpeta personalizada, la información que éste archivo contiene es algo como ésto:

???:confused::confused::confused:

bueno debi de empezar comentando que soy novato en esto ja ja ja
no entiendo muy bien que digamos :o, me quieres decir que no se puede hacer directamente al presionar un boton

Código Delphi [-]
var
....
procedure button1click.....
begin
...
end;

Lo que quizo decir cHackAll es que tienes que tener en la carpeta a personalizar un archivo llamado "Desktop.ini" con los atributos de Oculto (H) y Archivo de Sistema (S) , el cual se comporta como un archivo de registro, y debes acceder a él a través del componente TIniFile, guardando en los valores "IconFile" e "IconIndex" los datos referidos al ícono. Vaya el ejemplo: suponiendo que la carpeta es "Archivos de Programa" y el ícono es "C:\MiIcono.ico" sería:

Código Delphi [-]
uses ..., IniFiles;

procedure TForm1.Button1Click(Sender: TObject);
var archivo:TIniFile;
begin
  archivo:=TIniFile.Create('C:\Archivos de Programa\Desktop.ini');
  archivo.WriteString('.ShellClassInfo','IconFile','C:\MiIcono.ico');
  archivo.WriteInteger('.ShellClassInfo','IconIndex',0);
  archivo.Free;
end;

El "0" de "IconIndex" se refiere al número del ícono dentro del archivo, en este caso se utiliza el primer ícono del archivo "MiIcono.ico", pero puedes referirte a un ejecutable como "mplayer.exe" y obtener el 3er ícono de ese archivo poniendo "3" en "IconIndex".
Puede que el cambio de ícono no sea visible hasta que reinicies Windows porque éste usa una caché para mantener los íconos. También podría verse el cambio forzando a refrescar la caché de íconos, pero ese ya es otro tema.
Espero te quede claro.

hola de nuevo y gracias por la ayuda prestada chackall y paldave

hice la prueba y lo que paso es que se creo un archivo desktop.ini dentro de la carpeta con el texto
pero no cambió de icono, el archivo casco.ico es un icono comun y corriente , no es un archivo de iconos como creo me hacen mencion ya que no se puede elegir el icono 0 ó 1 como especifica '' IconIndex=0 ''esta por alli mi problema ??

Quise responderte con anterioridad pero el post se me borro :(
Lo que intentaba darte era un código parecido al siguiente:

Código Delphi [-]
procedure DefineIcon(Path, IconFile: string; IconIndex: Integer = 0);
var Desktop: Text;
begin
 Path := Path + '\Desktop.ini';
 AssignFile(Desktop, Path);
 ReWrite(Desktop);
 WriteLn(Desktop, '[.ShellClassInfo]');
 WriteLn(Desktop, 'IconFile=' + IconFile);
 WriteLn(Desktop, 'IconIndex=' + IntToStr(IconIndex));
 CloseFile(Desktop);
end;
 
procedure Form1.Button1Click(Sender: TObject);
begin
// DefineIcon('c:\Nueva carpeta', 'Icono.ico'); // El archivo Icono.ico está en la misma carpeta
// DefineIcon('c:\Nueva carpeta', '%SystemRoot%\system32\shell32.dll', 27); // El icono lo tomamos de una .DLL
 DefineIcon('c:\Nueva carpeta', 'c:\Archivos de programa\Delphi7SE\Projects\Project1.exe'); // El icono lo tomamos de nuestra aplicación
end;

Lo pruebas de las tres formas, y si hay algún errorcillo de sintaxis te pido disculpas pero no tenía un IDE cerca :)

Por lo que veía paldave te dio un ejemplo que hace lo mismo, y en ambos casos debería funcionar...

PD: No va por ahí el problema, IconIndex=0 es lo correcto
Saludos

al parecer aun hay un poblema no llega a compilar la varible desktop no puede ser definida como text, la cambie a string y el error paso a la linea con el siguiente desktop

podrias darle una mirada, no entiendo como manipular al archivo o variable desktop dentro de la procedure




Código Delphi [-] Unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IniFiles, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
Procedure DefineIcon(Path, IconFile: string; IconIndex: Integer = 0);
end;
var
Form1: TForm1;
implementation
procedure TForm1.Button1Click(Sender: TObject);
begin
DefineIcon('E:\Administrador\Mis documentos', 'E:\Administrador\Mis documentos\Nueva carpeta\Project1.exe');
End;
procedure Tform1.DefineIcon(Path, IconFile: string; IconIndex: Integer = 0);
var
Desktop: text;// aqui se detiene.
begin
Path := Path + '\Desktop.ini';
AssignFile(Desktop, Path);
ReWrite(Desktop);
WriteLn(Desktop, '[.ShellClassInfo]');
WriteLn(Desktop, 'IconFile=' + IconFile);
WriteLn(Desktop, 'IconIndex=' + IntToStr(IconIndex));
CloseFile(Desktop);
end;
end.




Ojala no se llege a complicar :o, gracias y saludos cHackAll .....

Evidentemente hay un error en la definición de la variable Desktop.
Devería definirse como File:

Código Delphi [-]
procedure DefineIcon(Path, IconFile: string; IconIndex: Integer = 0);
var Desktop: File;
begin...

O como TextFile mejor :o

Código Delphi [-]
procedure DefineIcon(Path, IconFile: string; IconIndex: Integer = 0);
var Desktop: TextFile;
begin...

Perdón por el error en la respuesta anterior.

hola denuevo :o je je

bueno paldave dio en el clavo ya compila pero, no cambia el icono aun :):):) lo extraño es que si crea el archivo desktop.ini dentro de la carpeta y con el texto:

[.ShellClassInfo]
IconFile=E:\Administrador\Mis documentos\Nueva carpeta\casco
IconIndex=0

la carpeta que quiero cambiar esta en E:\Administrador\Mis documentos se llama nueva carpeta y dentro esta el icono pero nada, creo que el problema ya no esta en la aplicacion sino en el archivo creado o me equivoco????
ayudenme por favor ya solo falta un pequeño paso.

Mencionas que el archivo queda como

pero debería ser

Al parecer hay un error en la extensión del archivo de ícono que deseas usar.

Como te dije antes el ícono no cambiará hasta que reinicies la máquina o refresques la caché de íconos de windows. Si no lo haces, es como que una vez que tuvieras cambiado el ícono de la carpeta y funcionando bien, editaras el archivo Desktop.ini con el block de notas, le cambiaras el ícono y lo volvieras a guardar. Evidentemente editarlo y cambiarlo con el block de notas no cambiará el ícono de la carpeta, ya que windows no lee el archivo desktop.ini de la carpeta cada vez que la muestra, sino que lo hace solo la primera vez que accedes a él y luego lo coloca en una caché para recuperarlo rápidamente cada vez que se muestre dicha carpeta, y dicha caché se mantiene hasta que reinicies Windows o lo fuerces a refrescarse, o lo vacíes.

Para refrescar la caché de íconos se necesita de un procedimiento algo complicado, pero casualmente tengo el código que necesitas a mano:

Código Delphi [-]
uses ...,ShlObj, ComObj, Registry;
procedure RebuildIconCache;
...

implementation
const
  sr_WindowMetrics='Control Panel\Desktop\WindowMetrics';
  sr_ShellIconSize='Shell Icon Size';
...

procedure RebuildIconCache;
var
 news,olds:string;
 sz:integer;
 reg:TRegistry;

 Function UpdateAllWindowsCallback(WHandle : HWnd;
  Var Parm : Pointer) :
  Boolean; stdcall;
  begin
   SendMessage(WHandle,WM_SETTINGCHANGE,0,0);
   Result:=True;
  end;

  Procedure UpdateAllWindows;
  Begin
    EnumWindows(@UpdateAllWindowsCallback,
    WM_SETTINGCHANGE);
  End;


  function GetIconCacheFile:string;
  begin
   Result:=GetWindowsDir+'ShellIconCache';
  end;

  procedure DeleteIconCache;
  var
   sfile:string;
  begin
    sfile:=GetIconCacheFile;
    if fileexists(sfile) then
    begin
      if deletefile(sfile)=false
      then showmessage('Can not erase file: '+sfile);
    end;
  end;


  function RefreshActiveDesktop:boolean;
  const
    CLSID_ActiveDesktop: TGUID
     = '{75048700-EF1F-11D0-9888-006097DEACF9}';
  var
    ActiveDesktop: IActiveDesktop;
  begin
    try
      ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
      ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
      Result:=true;
    except
      Result:=false;
    end;
  end;

  procedure RefreshDesktop;
  var
   wnd:THandle;
   fl:boolean;
  begin
    fl:=RefreshActiveDesktop;
    if fl=false then
    begin
      wnd:=FindWindow('Progman', 'Program Manager');
      if wnd<>0 then SendMessage(wnd,WM_COMMAND,$A065,0)
    else
      UpdateAllWindows;
    end;
end;

begin
 reg:=TRegistry.Create;
 try
   deletefile(GetIconCacheFile);
   reg.RootKey :=HKEY_CURRENT_USER;
   reg.OpenKey(sr_WindowMetrics,false);
   olds:=reg.ReadString(sr_ShellIconSize);
   sz:=strtointdef(olds,32);
   inc(sz);
   news:=inttostr(sz);
   Reg.WriteString(sr_ShellIconSize,news);
   UpdateAllWindows;
   if olds='' then olds:='32';
   Reg.WriteString(sr_ShellIconSize,olds);
   Reg.CloseKey;
   Reg.Free;
   UpdateAllWindows;
   RefreshDeskTop;
 finally
 end;
end;

Te aconsejo que uses la forma que yo te indiqué antes para acceder y/o crear el archivo Desktop.ini, ya que si usas la de cHackAll verás que si el archivo ya fué creado mediante "Personalizar Carpeta" por Windows y tiene los atributos de Oculto te dará un error al intentar acceder al mismo

Deberás poner tu procedimiento así:

Código Delphi [-]
uses ..., inifiles;

procedure TForm1.Button1Click(Sender: TObject);
var archivo:TIniFile;
begin
  archivo:=TIniFile.Create('C:\Carpeta a Personalizar\Desktop.ini');
  archivo.WriteString('.ShellClassInfo','IconFile','E:\Administrador\Mis documentos\Nueva carpeta\Casco.ico');
  archivo.WriteInteger('.ShellClassInfo','IconIndex',0);
  archivo.Free;

  RebuildIconCache;
end;

Espero que ahora sí puedas solucionar tu problema con los íconos. ;) Ya lo he probado y funciona de maravillas.

hola a todos :)
disculpen por no haberme comunicado en buen tiempo, esque tuve una semana muy mala,.... pero bueno¡¡¡¡ volviendo al tema

paldave los codigos que me das no me compilan en

Código Delphi [-]
Result:=GetWindowsDir+'ShellIconCache';

no tengo ni la mas minima idea de que pueda ser......:o

y sobre el texto en el archivo .ini creado, no hay problema alli, fue error mio al digitar la pregunta si hace la extencion casco.ini , y apesar de aver reiniciado ma maquina no cambia nada :(:(,


esperando alguna ayuda o sugerencia me despido, chau...:)

Te ruego mil disculpas, tienes razón, el error fué mío ya que a pesar de que lo probé y funciona perfecto se me "coló" esa llamada a una función que es mía y es la llamada GetWindowsDir. Lo que sucede es que tengo miles de rutinas propias en bibliotecas que utilizo para facilitar la programación y algunas de ellas tienen nombre similar a las de Windows y hace tanto que las uso que a veces me olvido que son mías solamente :o
Algunas me ahorran pequeños trozos de código como la citada, pero cuando tienes que programar mucho esa pequeña ayuda se agradece.
Va aquí el sencillo código de GetWindowsDir:

Código Delphi [-]
function GetWindowsDir:String;
var r,s:String;
begin
  s:=StringOfChar(#0,255);
  GetWindowsDirectory(pchar(s),255);
  result:=IncludeTrailingBackSlash(Trim(s));
end;

Espero que no tengas más problemas. :)

hola de nuevo (paldave):

:(:(:( no puedo creer que me complique por esta aplicacion que deseo hacer; pero bueno tengo que conseguirlo.

NO COMPILA aun con la funcion que me diste en la respuesta anterior, me parece que el problema va por la ubicacon de la función: debo declararlo como a los procedure?, o pornerlos defrente debajo de la zona privada o publica o talves debajo de:

Código Delphi [-]
 
implementation
{$R *.dfm}

sin declarlo, te recuerdo que son novato en esto :o:o pero con mucho interes en conocer mas. Te agradesco de ante mano la ayuda que me brindas y la ayuda que puedas darme con este nuevo paso.
GRACIAS Y HASTA LA PROXIMA....

Puedes ponerla en la sección Public de tu Form, algo así:

Código Delphi [-]
type
   TForm1 = class(TForm)
     private
     protected
     public
       function GetWindowsDir:String;
     published
   end;

y luego la implementas como:

Código Delphi [-]
function TForm1.GetWindowsDir:String;
var r,s:String;
begin
  s:=StringOfChar(#0,255);
  GetWindowsDirectory(pchar(s),255);
  result:=IncludeTrailingBackSlash(Trim(s));
end;

Hola a todos :):):)

paldave PORFIN, ya compila y al presionar el boton actualiza sistema a la perfección con un solo inconveniente NO CAMBIA EL ICONO :( jajajajajajaja.

se crea el archivo .ini correctamente

[.ShellClassInfo]
IconFile=E:\Administrador\disket\prueba de icono\casco.ico
IconIndex=0

-queda claro entonces que el problema no es el programa ni codigos???
-puede ser el problema el archivo de icono?? estoy utilizando el microangelo para la creación del icono e incluso iconos comunes bajados de internet
-la ubicación del archivo icono y la carpeta a modificar tiene algo que ver???

QUE SERA??????

Pues sí que es raro, a mi me funciona perfectamente :confused:
¿No será que tienes un problema en el Sistema Operativo?
Yo uso WinXP Professional con SP2.

hola a todos
si que raro, voya llevar la aplicación en otra computadora a ver si el problema es el sistema operativo.
traere noticias..............