Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2003.11.03;
Скачать: [xml.tar.bz2];

Вниз

как получить 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 вся ветка

Форум: "WinAPI";
Текущий архив: 2003.11.03;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.51 MB
Время: 0.009 c
14-8594
Blackman
2003-10-15 20:36
2003.11.03
Спокойной ночи малыши!

3-8304
wtkiv
2003-10-13 15:09
2003.11.03
Как убрать логин и пароль?

7-8678
Эл
2003-08-24 19:40
2003.11.03
Получение информации о системе

4-8732
w666w
2003-08-27 18:55
2003.11.03
Как определить, есть ли в системных путях (где либо) нужнй файл?

14-8638
Viks
2003-10-13 19:42
2003.11.03
Palm OS




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский