Foros Club Delphi - extraer un icono

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)

- - extraer un icono (https://www.clubdelphi.com/foros/showthread.php?t=1655)

extraer un icono

Hola, a ver si podeis ayudarme.
Quiero extraer el icono de un acceso directo y ponerlo en un TSpeedButton, como puedo hacer que no se vea la flecha esa que tiene el icono del acceso directo?? Es que queda muy fea.

Gracias anticipadas.

Pueba a sacar el icono directamente de la aplicación a la que apunte ese acceso directo.

Gracias por la informacion, pero, me podrias decir como obtengo la direccion de destino? Si le doy la direccion del lnk, como hago para que me saque la del exe al que apunta.

Gracias

La direccion del exe al que apunta la tienes en el propio icono. Si pulsas con el boton derecho del raton y seleccionas Propiedades, te aparece una pestaña en la que pone la UBICACION del programa al que apunta.

A ver te explico lo que quiero hacer exactamente:

Tengo un TSpeedButton y quiero que en el Glyph me aparezca el icono. Yo le doy la ruta del acceso directo, pero el icono aparece con un recuadro blanco por detras muy feo, asi que me gustaria o que se quitase ese recuadro, o que saliera el icono del exe al que apunta.
Como se lo digo al boton?
Gracias

Eso es otra cosa.
OK.
Puedes añadir un Timage a tu formulario y capturar en el el icono que quieres para tu boton:

Código:

procedure TForm1.FormCreate(Sender: TObject);

var

   Icono:TIcon;

   Indice:word;

begin

  Icono:=TIcon.Create;

  Indice:=0;

  Icono.handle:=ExtractAssociatedIcon(hInstance,

                Pchar('C:\DESARROLLO\unit1.pas'),Indice);

  Image1.Picture.Bitmap.Width:= Icono.Width;

  Image1.Picture.Bitmap.Height:= Icono.Height;

  Image1.Picture.Bitmap.Canvas.Draw(0,0,Icono);

  Icono.Free;

  //Le das el icono al boton. 

  Boton.Glyph:= Image1.Picture.Bitmap;

end;

No te olvides de añadir ShellApi en tu uses

Gracias otra vez, pero...
Si yo no se la direccion del .exe al que apunta el .lnk como hago para sacarla?

Te explico, yo quiero poner en :
Icon.handle:= ExtractAssociatedIcon( hInstance, Pchar(ruta), IconIndex);

Pero la ruta que le doy es la del .lnk y yo quiero que me busque el la del .exe.
He descubierto que con un OpenDialog eso lo hace directamente, cuando abro la ventana y elijo el acceso directo que quiero el mismo en el Filename me pone la ruta del ejecutable.
Quiero hacer eso en codigo, para no tener que utilizar el OpenDialog que no lo quiero para nada.

Gracias de antemano

Hola otra vez,

He estado mirando el Windows y he visto que con la interfaz IShellLink podría sacar los atributos de un acceso directo, y he pensado que quiza asi podria obtener la ruta a la que apunta para poder extraer el icono de ella, pero no se como utilizarla exactamente.

Gracias por anticipado

Hola Gemma,

Creo que esto es lo que necesitas ...

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShlObj, StdCtrls, ExtCtrls, ActiveX ;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
CD: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
AccesoDirecto : IShellLink;
end;

var
Form1: TForm1;

const
IID_IPersistFile : TGUID = (
D1:$0000010B;D2:$0000;D3:$0000;
D4: ($C0,$00,$00,$00,$00,$00,$00,$46));

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
CoInitialize( Nil );
CoCreateInstance( CLSID_ShellLink, Nil, CLSCTX_INPROC_SERVER,
IID_IShellLinkA, AccesoDirecto );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
PF : IPersistFile;
parametro : array[0..MAX_PATH] of char;
Visualization : integer;
Datos : TWin32FindData;
begin
Cd.Title := 'Seleccione el acceso directo a abrir';
Cd.Filter := 'Accesos directos (*.lnk)|*.lnk';
if cd.execute then
begin
AccesoDirecto.QueryInterface( IID_IPersistFile, PF );
PF.Load( StringToOleStr( Cd.FileName ), 0 );
AccesoDirecto.GetPath( Parametro, MAX_PATH, Datos, 0 );
edit1.text := Parametro;
end;
end;

end.

Espero que te funcione.

Saludos al foro.

Bueno, veo que te respondieron antes... pero como tuve que recopilar código para darte una respuesta, te la voy a pasar de todos modos.

El tema es así, yo tengo una Unit con todas las funciones, procedimientos y tipos relacionados con "Accesos directos" y otras cosas, en este código puedes ver la función GetLinkFileInfo que extrae información de un ShortCut:

Código:

unit XXXX;



interface



uses

  Windows, ShlObj;



type

  TLinkFileInfo = record

    FileName: string;

    WorkDirectory: string;

    IconLocation: string;

    IconIndex: Integer;

    Arguments: string;

    Description: string;

    ItemIdList: PItemIDList;

    RelativePath: string;

    ShowState: Integer;

    HotKey: Word;

  end;



function GetLinkFileInfo(const AFileName: string): TLinkFileInfo;



.........



implementation



uses

  SysUtils, ActiveX, ComObj;



function GetLinkFileInfo(const AFileName: string): TLinkFileInfo;

var

  hRes: hResult;

  IShLnk: IShellLink;

  Wfd: WIN32_FIND_DATA;

  IPFile: IPersistFile;

  FileBuff: PWideChar;

  PBuff: PChar;

begin

  GetMem(FileBuff, MAX_PATH);

  GetMem(PBuff, MAX_PATH);

  try

    OleCheck(CoInitialize(nil));

    try

      OleCheck(Cocreateinstance(CLSID_ShellLink, nil,

               CLSCTX_INPROC_SERVER, IID_IShellLinkA, IShLnk));

      hRes := IShLnk.QueryInterface(IPersistFile, IPFile);

      if Failed(hRes) then

        OleCheck(hRes)

      else

      begin

        StringToWideChar(AFileName, FileBuff, MAX_PATH);

        hRes := IPFile.load(FileBuff, STGM_READ);

        if Failed(hRes) then

          OleCheck(hRes)

        else

        begin

          hRes := IShLnk.resolve(0, SLR_NO_UI);

          if Succeeded(hRes) then

          begin

            IShLnk.GetPath(PBuff, MAX_PATH, Wfd, SLGP_SHORTPATH);

            Result.FileName := PBuff;



            IShLnk.GetIconLocation(PBuff, MAX_PATH, Result.IconIndex);

            Result.IconLocation := PBuff;



            IShLnk.GetWorkingDirectory(PBuff, MAX_PATH);

            Result.WorkDirectory := PBuff;



            IShLnk.GetDescription(PBuff, MAX_PATH);

            Result.Description := PBuff;



            IShLnk.GetArguments(PBuff, MAX_PATH);

            Result.Arguments := PBuff;



            IShLnk.GetHotKey(Result.HotKey);

            IShLnk.GetIdList(Result.ItemIdList);

            IShLnk.GetShowCmd(Result.ShowState);

          end;

        end;

      end;

    finally

      CoUninitialize;

    end;

  finally

    FreeMem(FileBuff);

    FreeMem(PBuff);

  end;

end;

.........

end.

La implementación de estas funciones podría ser esta:

Código:

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, Buttons;



type

  TForm1 = class(TForm)

    Button1: TButton;

    OpenDialog1: TOpenDialog;

    Edit1: TEdit;

    SpeedButton1: TSpeedButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



uses

  LnkUtils, ShellApi;



{$R *.DFM}



procedure TForm1.Button1Click(Sender: TObject);

var

  LnkInfo: TLinkFileInfo;

  AIconFile: TFileName;

  MyIcon: TIcon;

  wIcon: Word;

begin

  {Trae la información del Link}

  LnkInfo := GetLinkFileInfo('c:\fede\Editar Autoexec.lnk');

  if LnkInfo.IconLocation = '' Then

    AIconFile := LnkInfo.FileName {Si el ícono es del mismo archivo}

  else

    AIconFile := LnkInfo.IconLocation; {Si el ícono es de otro archivo}

  wIcon := LnkInfo.IconIndex;



  MyIcon:=TIcon.Create;

  Try

    {Extrae el Ícono}

    MyIcon.Handle := ExtractAssociatedIcon(hInstance, PChar(AIconFile), wIcon);

    {Dibuja el Ícono en el Botón}

    SpeedButton1.Glyph.Width := MyIcon.Width;

    SpeedButton1.Glyph.Height:= MyIcon.Height;

    SpeedButton1.Glyph.Canvas.Draw(0, 0, MyIcon);

  finally

    MyIcon.Free;

  end;

end;



end.

Bueno, espero que te sea de utilidad, podes recortar el código a tu gusto.

Saludos!

Muchisimas gracias a todos por vuestra ayuda. Ya lo tengo solucionado.