Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > Получение иконок

Автор: RMiB 18.5.2009, 22:30

В программе нужно получить иконку Мой компьютер и вывести её в Image, нашёл, что для нахождения иконки можно использовать SHGetFileInfo(LPCTSTR pszPath,...) у которого(справка по win32):
If uFlags includes the SHGFI_PIDL, value pszPath must be the address of an ITEMIDLIST structure that contains the list of item identifiers that uniquely identifies the file within the shell's name space.
вот код:

Код


procedure TForm1.FormCreate(Sender: TObject);
var ImageHandle:thandle;
    info:SHFILEINFO;
begin  
  ImageHandle:= SHGetFileInfo('',0,info,sizeof(info),SHGFI_PIDL);
  if (ImageHandle <> 0) then
  begin
    ImageList1.Handle:= ImageHandle;
    ImageList1.ShareImages:= true;
  end;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var info:shfileinfo;
    result:integer;
    PIDL:PItemIDList;
begin
  SHGetSpecialFolderLocation( Handle, CSIDL_DRIVES, PIDL );
  result:= SHGetFileInfo(pointer(PIDL),0,info,sizeof(info),SHGFI_PIDL);
   if(result <> 0) then
    ImageList1.GetIcon(info.iIcon,Image1.Picture.Icon);
end;

как поправить чтоб оно работало??, или возможно есть другой способ получения иконки Моего компьютера???

Автор: Keeper89 18.5.2009, 23:03

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TIconType = (itSmall, itLarge);

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetIcon(PIDL: PItemIDList;
                 IconType: TIconType = itSmall): TIcon;
const
  SFGAO_SHARE = $20000;
  Flags: array[TIconType] of DWORD = (SHGFI_SMALLICON, SHGFI_LARGEICON);
var
  FileInfo: TSHFileInfo;
  Ico: TIcon;
  ListHandle: HIMAGELIST;
begin
  Ico := TIcon.Create;
  Result := Nil;
  with Ico do
  begin
    FillChar(FileInfo, Sizeof(FileInfo), #0);
    ListHandle := SHGetFileInfo(Pointer(PIDL), SFGAO_SHARE, FileInfo,
                                SizeOf(FileInfo),
                                Flags[IconType] or
                                SHGFI_SYSICONINDEX or
                                SHGFI_PIDL);
    if ListHandle <> 0 then
    begin
      Handle := ImageList_GetIcon(ListHandle, FileInfo.iIcon, ILD_NORMAL);
      Result := Ico;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PIDL: PItemIDList;
begin
  SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, PIDL);
  Image1.Picture.Icon := GetIcon(PIDL);
end;

end.

Автор: Rrader 19.5.2009, 06:49

Keeper89,

1) PIDL надо освобождать.
2)

Код


CoInitialize(nil);

3)Функцию лучше переделать в процедуру, а результат в виде объекта реализовать как параметр.

Автор: Keeper89 19.5.2009, 16:11

Rrader, первые 2 исправил.

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TIconType = (itSmall, itLarge);

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetIcon(PIDL: PItemIDList;
                 IconType: TIconType = itSmall): TIcon;
const
  SFGAO_SHARE = $20000;
  Flags: array[TIconType] of DWORD = (SHGFI_SMALLICON, SHGFI_LARGEICON);
var
  FileInfo: TSHFileInfo;
  Ico: TIcon;
  ListHandle: HIMAGELIST;
begin
  Ico := TIcon.Create;
  Result := Nil;
  with Ico do
  begin
    FillChar(FileInfo, Sizeof(FileInfo), #0);
    ListHandle := SHGetFileInfo(Pointer(PIDL), SFGAO_SHARE, FileInfo,
                                SizeOf(FileInfo),
                                Flags[IconType] or
                                SHGFI_SYSICONINDEX or
                                SHGFI_PIDL);
    if ListHandle <> 0 then
    begin
      Handle := ImageList_GetIcon(ListHandle, FileInfo.iIcon, ILD_NORMAL);
      Result := Ico;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PIDL: PItemIDList;
begin
  SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, PIDL);
  Image1.Picture.Icon := GetIcon(PIDL);
  CoTaskMemFree(PIDL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CoInitialize(nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  OleUnInitialize;
end;

end.

А переделывать в процедуру зачем?

Автор: Rrader 20.5.2009, 14:51

Цитата(Keeper89 @ 19.5.2009, 22:11

)

А переделывать в процедуру зачем?

Для упрощения кода, для облегчения его восприятия. У тебя сейчас функция забирает память - с каждым входом новый объект. А зачем так делать? У Image уже есть в распоряжении Picture.Icon. Плюс желательно сделать проверочку на успешность SHGetSpecialFolderLocation.

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  SFGAO_SHARE = $20000;
var
  FileInfo: TSHFileInfo;
  ListHandle: HIMAGELIST;
  ID: PItemIDList;
begin
  with Image1 do
  begin
    if Succeeded(SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, ID)) then
    try
      FillChar(FileInfo, SizeOf(FileInfo), 0);
      ListHandle := SHGetFileInfo(Pointer(ID), SFGAO_SHARE, FileInfo,
        SizeOf(FileInfo), SHGFI_LARGEICON or  SHGFI_SYSICONINDEX
        or SHGFI_PIDL);
      if ListHandle <> 0 then
      begin
        Width := GetSystemMetrics(SM_CXICON);
        Height := GetSystemMetrics(SM_CYICON);
        Picture.Icon.Handle := ImageList_GetIcon(ListHandle,
          FileInfo.iIcon, ILD_NORMAL);
      end;
    finally
      CoTaskMemFree(ID);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not Succeeded(CoInitialize(nil)) then
  begin
    ShowMessage('Unable to initialize COM library!');
    Application.Terminate;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CoUnInitialize;
end;

end.