Chciałbym podjąć temat programowego przypinania ikon w Windows.
O ile się orientuję, nie ma żadnego API, które realizowałoby to zadanie. Są jednak rozwiązania, które działają. Niestety, nie potrafię zmusić kodu (patrz niżej), aby działał w Windows 10 - w systemie Windows 7 działa OK.
Moduł ShellVerb.pas
unit ShellVerb;
interface
uses Windows, SysUtils, Variants, Classes, ComObj, ActiveX;
type
TShellVerb = (svPinToTaskBar, svUnpinFromTaskBar, svPinToStartMenu, svUnpinFromStartMenu);
procedure ExecuteVerb(const FileName: string; Verb: TShellVerb); overload;
implementation
function ExecuteVerb(const FileName, VerbName: string): Boolean; overload;
var
AOleFolder: OleVariant;
AOleFolderItem: OleVariant;
AShell: OleVariant;
AName: string;
I: Integer;
begin
CoInitialize(nil);
try
AShell := CreateOleObject('Shell.Application');
AOleFolder := AShell.Namespace(ExcludeTrailingPathDelimiter(ExtractFileDir(FileName)));
AOleFolderItem := AOleFolder.ParseName(ExtractFileName(FileName));
for I := 0 to AOleFolderItem.Verbs.Count - 1 do
begin
AName := AOleFolderItem.Verbs.Item(I).Name;
if AName = VerbName then
begin
AOleFolderItem.Verbs.Item(I).DoIt;
Exit(True);
end;
end;
Result := False;
finally
CoUninitialize();
end;
end;
procedure ExecuteVerb(const FileName: string; VerbID: array of Integer); overload;
var
AHandle: THandle;
AVerbNameBuffer: array[Byte] of Char;
I: Integer;
begin
AHandle := LoadLibrary('shell32.dll');
for I := Low(VerbID) to High(VerbID) do
if LoadStringW(AHandle, VerbID[I], @AVerbNameBuffer, Length(AVerbNameBuffer)) > 0 then
begin
ExecuteVerb(FileName, AVerbNameBuffer);
Break;
end;
end;
procedure ExecuteVerb(const FileName: string; Verb: TShellVerb); overload;
begin
case Verb of
svPinToTaskBar : ExecuteVerb(FileName, [5386]);
svUnpinFromTaskBar : ExecuteVerb(FileName, [5387]);
svPinToStartMenu : ExecuteVerb(FileName, [51201, 5381]);
svUnpinFromStartMenu : ExecuteVerb(FileName, [51394, 5382]);
end;
end;
// Wywołanie:
procedure Button1Click(Sender: TObject);
begin
// svPinToTaskBar, svUnpinFromTaskBar, svPinToStartMenu, svUnpinFromStartMenu
ExecuteVerb('ŚĆIEŻKA DOSTĘPU DO APLIKACJI', svPinToTaskBar);
end;
Ma ktoś jakiś pomysł jak to zrealizować poprawnie w Windows 10?
Jak już wspomniałem, testowałem na Windows 7 i tam jest OK - ikonka aplikacji jest prawidłowo przypinana na pasku zadań lub w Menu Start.
Proszę o pomoc w tej materii,
-Pawel