Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Как подружить и ... ... ExtractAssociatedIcon ? 
V
    Опции темы
navodri
Дата 5.12.2010, 18:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1
Мне нужно создать ярлык к программе с иконкой оптического привода, а не программы.  Как известно, ExtractAssociatedIcon возвращает хендл иконки. А в конструкции MySLink.SetIconLocation нужно указывать путь к иконке. Вопрос: как подружить MySLink.SetIconLocation и ExtractAssociatedIcon ?


Код

uses
  ...ShlObj, ActiveX, ComObj, ShellApi;

function GetAssociatedIcon(FileName: String; IconIndex: Word): hIcon;
begin
 Result := ExtractAssociatedIcon(HInstance, PChar(FileName), IconIndex);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 MyObject: IUnknown;
 MySLink: IShellLink;
 MyPFile: IPersistFile;
 WFileName: WideString;
 IconIndex: Word;
 icon: hIcon;
begin
   MyObject := CreateComObject(CLSID_ShellLink);
   MySLink := MyObject as IShellLink;
   MyPFile := MyObject as IPersistFile;
    with MySLink do begin
     SetPath(PChar(ParamStr(0)));
     SetArguments('params');
     SetWorkingDirectory(PChar(ExtractFilePath(ParamStr(0))));

     //Вытянул иконку своего оптического привода (E:\)...
     icon := GetAssociatedIcon(PChar('E:\'), IconIndex);

     //...а теперь, как ее назначить ярлыку, ведь SetIconLocation требует путь к иконке, а не хендл?
     SetIconLocation('путь к иконке', 0);

    end;
   WFileName := ParamStr(0) + '.lnk';
   MyPFile.Save(PWChar(WFileName), False);
end;


Это сообщение отредактировал(а) navodri - 5.12.2010, 21:03
PM MAIL WWW   Вверх
Keeper89
Дата 5.12.2010, 18:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
А разве автоматически иконка нужной не будет (без указания SetIconLocation)?

Это сообщение отредактировал(а) Keeper89 - 5.12.2010, 18:44


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
navodri
Дата 5.12.2010, 19:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1
2Keeper89. 
Как видно по коду, ярлык создается к своей программе, а иконку нужно стянуть с оптического привода.
PM MAIL WWW   Вверх
Keeper89
Дата 5.12.2010, 20:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
А, ну тогда есть функция GetIconLocation с флагом SHGFI_ICONLOCATION.

Это сообщение отредактировал(а) Keeper89 - 5.12.2010, 20:22


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
navodri
Дата 5.12.2010, 20:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1
Невижу никакого смысла в ее применении/ Она возвращает Integer. А мне для SetIconLocation('путь к иконке', 0) нужен Pchar (путь к иконке).
PM MAIL WWW   Вверх
Keeper89
Дата 5.12.2010, 22:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58
Цитата(navodri @  5.12.2010,  20:34 Найти цитируемый пост)
Она возвращает Integer

Путь и индекс:

http://msdn.microsoft.com/en-us/library/bb...28VS.85%29.aspx


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
navodri
Дата 5.12.2010, 23:03 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1
Решено! Спасибо за участие! Рабочий код:

Код

procedure TForm1.Button1Click(Sender: TObject);
var
 MyObject: IUnknown;
 MySLink: IShellLink;
 MyPFile: IPersistFile;
 WFileName: WideString;
 ShInfo: TSHFileInfo;
begin
   MyObject := CreateComObject(CLSID_ShellLink);
   MySLink := MyObject as IShellLink;
   MyPFile := MyObject as IPersistFile;
    with MySLink do begin
     SetPath(PChar(ParamStr(0)));
     SetArguments('params');
     SetWorkingDirectory(PChar(ExtractFilePath(ParamStr(0))));
     SHGetFileInfo(PChar('E:\'), 0, ShInfo, SizeOf(ShInfo), SHGFI_ICONLOCATION);
     SetIconLocation(ShInfo.szDisplayName, ShInfo.iIcon);
    end;
   WFileName := ParamStr(0) + '.lnk';
   MyPFile.Save(PWChar(WFileName), False);
end;
PM MAIL WWW   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0667 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.