Показать сообщение отдельно
  #1  
Старый 22.10.2014, 21:51
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
Вопрос Дублировать ярлык, изменив его свойства и иконку

Здравствуйте.

Делаю программку, с помощью которой можно будет настраивать свойство ярлыка.

В программе я указываю путь к exe файлу, который мне придется дублировать(кинуть на раб. стол) и изменить его свойства. Всё это я уже сделал.
Мне осталось лишь научить программу менять иконку ярлыка.

Вытащить иконку с любого ярлыка я могу, но вот вставить в свой(дублированный ярлык) не могу. Прошу помощи.

Хочу привести код, с которым я редактирую свойства ярлыка.
Код:
procedure TForm1.createshotcut(sourcefile, shortcutname,
  sourceparams: string);
var
 IUnk: IUnknown;
 ShellLink: IShellLink;
 ShellFile: IPersistFile;
 tmpShortCutName: string;
 WideStr: WideString;
 i: Integer;
begin
 IUnk := CreateComObject(CLSID_ShellLink);
 ShellLink := IUnk as IShellLink;
 ShellFile  := IUnk as IPersistFile;

 ShellLink.SetPath(PChar(SourceFile));
 ShellLink.SetArguments(PChar(SourceParams));
 ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));

 ShortCutName := ChangeFileExt(ShortCutName,'.lnk');
 if fileexists(ShortCutName) then
  begin
   ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4);
   i := 1;
   repeat
    tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk';
    inc(i);
   until not fileexists(tmpShortCutName);
   WideStr := tmpShortCutName;
 end
  else
   WideStr := ShortCutName;
 ShellFile.Save(PWChar(WideStr),False);
end;


procedure TForm1.sButton2Click(Sender: TObject);
var
 WorkTable:String;
 P:PItemIDList;
 C:array [0..1000] of char;
begin

 if SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,p)=NOERROR then
  begin
   SHGetPathFromIDList(P,C);
   WorkTable:=StrPas(C);
  end;

 if FileExists(WorkTable+'\'+ExtractFileName(Application.ExeName)) then
  DeleteFile(WorkTable+'\'+ExtractFileName(Application.ExeName));

 CreateShotCut(sEdit1.Text, WorkTable+'\'+ExtractFileName(sEdit2.Text), sEdit3.Text);
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
if sopendialog1.Execute then
 S:=sOpenDialog1.FileName;
 sedit1.Text:=S;
 sButton2.Enabled:=True;
end;

Каким образом я могу изменить иконку создаваемого ярлыка ? По стандарту иконка остается от оригинала.
Спасибо.
Ответить с цитированием