Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.11.03;
Скачать: CL | DM;

Вниз

как получить hIcon иконки файла, используя SHGetFileInfo ?   Найти похожие ветки 

 
Сергей Резников ©   (2003-08-28 14:08) [0]

Подскажите, пожалуйста, как получить hIcon иконки файла по его имени, используя SHGetFileInfo ?
Именно любой - т.е. если это текстовый файл, то вернуть его иконку.


 
Юрий Федоров ©   (2003-08-28 14:16) [1]

function GetShellFileIcon(const FileName : string) : HICON;
var SYSIL : THandle;
SFI : TSHFileInfo;
begin
Result:=0;
FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(FileName), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0
then Result:=ImageList_GetIcon(SysIL, SFI.iIcon, 0)
else RaiseLastOSError;

end;


 
Сергей Резников ©   (2003-08-28 14:20) [2]


> Юрий Федоров

ImageList_GetIcon - не работает


 
Skier ©   (2003-08-28 14:28) [3]

>Сергей Резников © (28.08.03 14:20)
А уже имея SFI.iIcon TIcon не пробовал задействовать ?


 
Сергей Резников ©   (2003-08-28 14:31) [4]

Вот исходник:

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
t: TListItem;
fi, fif1, fif2: TSHFileInfo;
F: TSearchRec;
ic: TIcon;
SmallImages: TImageList;
SYSIL : THandle;
SFI : TSHFileInfo;

begin

/////////////////////////////////////////////////////////
FindFirst("c:\*.*", faAnyFile, F);

while FindNext(F) = 0 do
begin
SHGetFileInfo(PAnsiChar(F.Name), 0, fi,
SizeOf(fi), SHGFI_ICON or SHGFI_SMALLICON);

t := ListView1.Items.Add;
t.Caption := F.Name;

FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(F.Name), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0
then ic.Handle := SFI.iIcon; //ImageList1.GetIcon (SysIL, SFI.iIcon, 0)

ImageList1.AddIcon(ic);
t.ImageIndex := 0;
end;

FindClose(F);

end;


 
Юрий Федоров ©   (2003-08-28 14:33) [5]

>>ImageList_GetIcon - не работает
Как не работает, что говорит SysErrorMessage(GetLastError)?


 
Skier ©   (2003-08-28 14:34) [6]

а где ты ic создаёшь ? Не видно.


 
Сергей Резников ©   (2003-08-28 14:35) [7]


> Юрий Федоров

Дельфи говорит, что такой функции нет :-(


 
Skier ©   (2003-08-28 14:36) [8]

uses Commctrl;


 
Сергей Резников ©   (2003-08-28 14:42) [9]

Функция появилась, но код неправильно работаёт - вместо иконок, чёрный квадраты.
Посмотрите, что не так:

procedure TForm1.FormCreate(Sender: TObject);
var
t: TListItem;
F: TSearchRec;
ic: TIcon;
SmallImages: TImageList;
SysIl : THandle;
SFI : TSHFileInfo;
begin
FindFirst("c:\*.*", faAnyFile, F);

while FindNext(F) = 0 do
begin
SHGetFileInfo(PAnsiChar(F.Name), 0, fi,
SizeOf(fi), SHGFI_ICON or SHGFI_SMALLICON);

t := ListView1.Items.Add;
t.Caption := F.Name;

FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(F.Name), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0
then ic.Handle := ImageList_GetIcon (SysIL, SFI.iIcon, 0);

ImageList1.AddIcon(ic);
t.ImageIndex := 0;
end;

FindClose(F);

end;


 
Юрий Федоров ©   (2003-08-28 14:43) [10]

см. Skier © (28.08.03 14:34) [6]


 
Сергей Резников ©   (2003-08-28 14:43) [11]

SHGetFileInfo(PAnsiChar(F.Name), 0, fi,
SizeOf(fi), SHGFI_ICON or SHGFI_SMALLICON);
- не обращайте внимания- ещё не удалил.


 
Сергей Резников ©   (2003-08-28 14:46) [12]

Теперь белый фон, а не иконки:

procedure TForm1.FormCreate(Sender: TObject);
var
t: TListItem;
F: TSearchRec;
ic: TIcon;
SmallImages: TImageList;
SysIl : THandle;
SFI : TSHFileInfo;
begin
FindFirst("c:\*.*", faAnyFile, F);
ic := TIcon.Create;
while FindNext(F) = 0 do
begin
t := ListView1.Items.Add;
t.Caption := F.Name;

FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(F.Name), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0
then ic.Handle := ImageList_GetIcon (SysIL, SFI.iIcon, 0);

ImageList1.AddIcon(ic);
t.ImageIndex := 0;
end;

FindClose(F);

end;


 
Skier ©   (2003-08-28 14:49) [13]

Попробуй так :

...then Icon.Handle := ImageList_GetIcon (SysIL, SFI.iIcon, 0);

У формы иконка не изменится ?


 
Юрий Федоров ©   (2003-08-28 14:51) [14]

t.ImageIndex := ImageList1.AddIcon(ic);
ic.Free;


 
Сергей Резников ©   (2003-08-28 14:52) [15]

Нет.


 
Юрий Федоров ©   (2003-08-28 14:53) [16]

И создавать ic тоже внутри цикла while


 
Skier ©   (2003-08-28 14:53) [17]

>Сергей Резников © (28.08.03 14:52)
Кысмет ! :))


 
Сергей Резников ©   (2003-08-28 14:59) [18]

It does not work.


 
Сергей Резников ©   (2003-08-28 15:03) [19]

procedure TForm1.FormCreate(Sender: TObject);
var
t: TListItem;
F: TSearchRec;
ic: TIcon;
SmallImages: TImageList;
SysIl : THandle;
SFI : TSHFileInfo;
begin
FindFirst("c:\*.*", faAnyFile, F);
while FindNext(F) = 0 do
begin
t := ListView1.Items.Add;
t.Caption := F.Name;
ic := TIcon.Create;

FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(F.Name), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0
then ic.Handle := ImageList_GetIcon (SysIL, SFI.iIcon, 0);

ImageList1.AddIcon(ic);
ic.Free;
t.ImageIndex := 0;
end;

FindClose(F);

end;


 
Юрий Федоров ©   (2003-08-28 15:08) [20]

t.ImageIndex := 0;
???


 
Skier ©   (2003-08-28 15:10) [21]

А ежели для контроля сохранить ic в файл ? Что там будет ?


 
Сергей Резников ©   (2003-08-28 15:12) [22]


> Юрий Федоров © (28.08.03 15:08) [20]

иначе к ListView1 иконку не привяжишь.


 
Сергей Резников ©   (2003-08-28 15:14) [23]


> Skier © (28.08.03 15:10) [21]

Icon image is not valid ...


 
Сергей Резников ©   (2003-08-28 15:15) [24]

SHGFI_SYSICONINDEX or SHGFI_SMALLICON - неправильные параметры, я думаю.


 
Skier ©   (2003-08-28 15:20) [25]

SHGFI_LARGEICON or SHGFI_SMALLICON or SHGFI_ICON ?


 
Сергей Резников ©   (2003-08-28 15:22) [26]

Ноль имоций.


 
Юрий Федоров ©   (2003-08-28 15:25) [27]

if SysIL <> 0
Выполняется условие ?
(зря raise убрал)


 
Сергей Резников ©   (2003-08-28 15:33) [28]

System error. Code: 2. The system cannot find the file specified


 
Skier ©   (2003-08-28 15:35) [29]

>Сергей Резников © (28.08.03 15:33)
Так может путь F.Name неверный ?
Проверь через FileExists(...)


 
Сергей Резников ©   (2003-08-28 15:36) [30]

SysIL := SHGetFileInfo(PChar("c:\" + F.Name) - появляется стандартная иконка у всех файлов и папок ... :-(


 
Сергей Резников ©   (2003-08-28 15:48) [31]

Рабочий код !!!:

procedure TForm1.FormCreate(Sender: TObject);
var
t: TListItem;
F: TSearchRec;
ic: TIcon;
Image: TImageList;
SysIl : THandle;
SFI : TSHFileInfo;
i: integer;
begin
FindFirst("c:\*.*", faAnyFile, F);
ImageList1.Clear;
i := 0;
while FindNext(F) = 0 do
begin
t := ListView1.Items.Add;
t.Caption := F.Name;
ic := TIcon.Create;
FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar("c:\" + F.Name), 0, SFI, SizeOf(SFI), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX );
if SysIL <> 0
then ic.Handle := ImageList_GetIcon (SysIL, SFI.iIcon, 0)
else RaiseLastOSError;

ImageList1.AddIcon(ic);
ic.SaveToFile("C:\Documents and Settings\Administrator\Desktop\bla.ico");
ic.Free;
t.ImageIndex := i;
i := i + 1;
end;

FindClose(F);

end;


 
Сергей Резников ©   (2003-08-28 15:57) [32]

Пасиба всем, кто помог !



Страницы: 1 вся ветка

Текущий архив: 2003.11.03;
Скачать: CL | DM;

Наверх




Память: 0.54 MB
Время: 0.022 c
1-8459
zapped
2003-10-24 13:13
2003.11.03
Delphi 5 vs Delphi 7


14-8663
isko
2003-10-14 08:16
2003.11.03
рядом с нами


1-8495
Egorr
2003-10-23 21:41
2003.11.03
Delphi && Internet Explorer


1-8539
First_May
2003-10-23 09:31
2003.11.03
Delphi & 1C


1-8359
Alfred
2003-10-23 09:49
2003.11.03
Обмен данными между двумя программами