extraer un icono

[gemma]

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.

[Investment]

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

[gemma]

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

[Investment]

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.

[gemma]

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

[Investment]

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

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

[gemma]

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

[gemma]

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

[ACK]

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.

[delphi.com.ar]

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:

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:

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!

[gemma]

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