Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.04.2019, 00:23   #1
grafgrial
Просто хороший
Форумчанин
 
Аватар для grafgrial
 
Регистрация: 26.03.2010
Сообщений: 562
По умолчанию Создание иконок списка файлов

Привет парни, помогите в создании программки. Которая считывает все ярлыки из одной папки и выводит их (хочу программу в "своем виде" похожую на Rocketdock)
Код что имеется не работает, может что-то сможете подсказать?

Код:
//Получаю список ярлыков в папке (пример)
//GetAllFiles( 'C:\Users\winda\Games', listbox1 );

procedure TForm1.GetAllFiles(Path: string; Lb: TListBox);
var
sRec: TSearchRec;
isFound: boolean;
begin
isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
while isFound do
begin
if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then
begin
if ( sRec.Attr and faDirectory ) = faDirectory then
GetAllFiles( Path + '\' + sRec.Name, Lb );
Lb.Items.Add( Path + '\' + sRec.Name );
end;
Application.ProcessMessages;
isFound := FindNext( sRec ) = 0;
end;
FindClose( sRec );
end;

//Пытался создать иконки, но никак

function GetRegistryIconHandle(FileName: string): HICON;
var
 R: TRegistry;
 Alias, //псевдвним для расширения в реестре
 IconPath: string; //путь для файла с иконкой
 IconNum, //номер иконки в файле
 QPos: Integer; //позиция запятой в записи реестра
begin
 IconNum := 0;
 R := TRegistry.Create;    
 try
   R.RootKey := HKEY_CLASSES_ROOT;
   if R.OpenKey('\' + ExtractFileExt(FileName), True) then
     Alias := R.ReadString('');
   R.CloseKey;
   if R.OpenKey('\' + Alias + '\DefaultIcon', True) then
     IconPath := R.ReadString('');
   R.CloseKey;
   QPos := Pos(',', IconPath);
   if QPos <> 0 then
   begin
     IconNum := StrToInt(Copy(IconPath, QPos + 1, 4));
     IconPath := Copy(IconPath, 1, QPos - 1)
   end;
 finally
   R.Free;
 end;
 Result := ExtractIcon(hInstance, PChar(IconPath), IconNum);
end;


function GetIcon(const FileName: string; const IconType: TIconType = itSmall):
 TIcon;
var
 FileInfo: TShFileInfo;
 ImageList: TImageList;
 IT: DWORD;
begin
 // CoInitialize; лучше - поместите вызов этой ф. в раздел initialization
 IT := SHGFI_SMALLICON;
 Result := TIcon.Create;
 ImageList := TImageList.Create(nil);
 if (IconType = itLarge) then
 begin
  IT := SHGFI_LARGEICON;
  ImageList.Height := 32;
  ImageList.Width := 32;
 end;
 FillChar(FileInfo, Sizeof(FileInfo), #0);
 ImageList.ShareImages := true;
 ImageList.Handle := SHGetFileInfo(
  PChar(FileName),
  SFGAO_SHARE,
  FileInfo,
  sizeof(FileInfo),
  IT or SHGFI_SYSICONINDEX
  );
 ImageList.GetIcon(FileInfo.iIcon, Result);
 ImageList.Free;
end;
Помог, нажми весы слева
grafgrial вне форума Ответить с цитированием
Старый 29.05.2019, 08:55   #2
ResourceSpace
Форумчанин
 
Аватар для ResourceSpace
 
Регистрация: 30.06.2015
Сообщений: 353
По умолчанию

Попробуйте лучше через интерфейс IShellItemImageFactory.
ResourceSpace вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
создание и установка иконок werus Компоненты Delphi 2 12.06.2010 23:23
Запись иконок из ехе файлов в imagelist с последующим присвоением картинки компоненту image. xaero93 Помощь студентам 2 13.04.2010 14:45
Программа получения списка файлов директории и изменения атрибутов файлов roma86 Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 7 09.06.2009 09:08
Извлечение иконок из PE файлов uberchel Софт 1 20.03.2009 00:14
Загрузка иконок файлов igroman Общие вопросы Delphi 4 29.05.2008 09:00