Windows 7のピン止め機能を無効にする

Windows 7の新機能の一つにタスクバーへのピン止め(pinning、日本マイクロソフトの表現では"固定表示")があります。この機能はタスクバーと従来のクイックリンクを統合したようなもので、ユーザの明示的な操作によりタスクバー上のプログラムをピン止めし、非起動状態と起動状態の区別を考慮することなく扱うことができる、というものです(プログラム側からピン止めを設定することはできない)。しかしプログラムによってはこの機能を使ってほしくないこともあります。そこでプログラム側でピン止め機能を無効化してみます。

MSDNのApplication User Model IDs (AppUserModelIDs) (Windows)のExclusion Lists for Taskbar Pinning and Recent/Frequent ListsによればAppUserModelIDを設定する前にSystem.AppUserModel.PreventPinningプロパティを設定することでピン止めが無効化されます。Windowsプロパティの設定はSHGetPropertyStoreForWindowで行います。ところがこのWindowsプロパティに関係する定義はDelphi 2010で追加されたPropSysユニット、PropKeyユニットには存在するものの、Delphi 2009およびそれ以前のバージョンでは独自に定義する必要があります。またプロパティキーPKEY_AppUserModel_PreventPinningはDelphi 2010でも定義が存在しないため、これも独自に定義します。

uses
  Windows, SysUtils, ShellAPI, ActiveX
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF RTLVersion >= 21.00}
  , PropSys, PropKey
{$IFEND}
{$ENDIF}
;

{$IFDEF CONDITIONALEXPRESSIONS}
{$IF RTLVersion < 21.00}
const
  SID_IPropertyStore = '{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}';

  IID_IPropertyStore: TGUID = SID_IPropertyStore;
  {$EXTERNALSYM IID_IPropertyStore}

type
  { interface IPropertyStore }
  IPropertyStore = interface(IUnknown)
  [SID_IPropertyStore]
    function GetCount(out cProps: DWORD): HRESULT; stdcall;
    function GetAt(iProp: DWORD; out pkey: TPropertyKey): HRESULT; stdcall;
    function GetValue(const key: TPropertyKey; out pv: TPropVariant): HRESULT; stdcall;
    function SetValue(const key: TPropertyKey; const propvar: TPropVariant): HRESULT; stdcall;
    function Commit: HRESULT; stdcall;
  end;
  {$EXTERNALSYM IPropertyStore}

type
  TSHGetPropertyStoreForWindow = function (hwnd: HWND; const riid: TGUID;
                                           var ppv: Pointer): HResult; stdcall;
{$IFEND}
{$ENDIF}

const
  PKEY_AppUserModel_PreventPinning : TPropertyKey = (
    fmtid : '{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}'; pid : 9);
  {$EXTERNALSYM PKEY_AppUserModel_PreventPinning}


function MarkWindowAsUnpinnable(handle: HWND): HRESULT;
var
  pps: IPropertyStore;
  v: TPropVariant;
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF RTLVersion < 21.00}
  hModule: THandle;
  SHGetPropertyStoreForWindow: TSHGetPropertyStoreForWindow;
{$IFEND}
{$ENDIF}
begin

  Result := 0;

  if CheckWin32Version(6,1) = False then
  begin
    Exit;
  end;

{$IFDEF CONDITIONALEXPRESSIONS}
{$IF RTLVersion < 21.00}
  hModule := LoadLibrary(shell32);
  if hModule = 0 then
  begin
    Exit;
  end;

  try
    @SHGetPropertyStoreForWindow := GetProcAddress(hModule,'SHGetPropertyStoreForWindow');
    if Assigned(SHGetPropertyStoreForWindow) = False then
    begin
      Exit;
    end;
{$IFEND}
{$ENDIF}

    Result := SHGetPropertyStoreForWindow(handle,IID_IPropertyStore,Pointer(pps));
    if Succeeded(Result) = True then
    begin
      v.vt := VT_BOOL;
      v.boolVal := True;
      Result := pps.SetValue(PKEY_AppUserModel_PreventPinning,v);
    end;
    pps := nil;

{$IFDEF CONDITIONALEXPRESSIONS}
{$IF RTLVersion < 21.00}
  finally
    FreeLibrary(hModule);
  end;
{$IFEND}
{$ENDIF}

end;

MarkWindowAsUnpinnableはメインフォームのOnCreateイベントハンドラで

procedure TForm1.FormCreate(Sender: TObject);
begin

  MarkWindowAsUnpinnable(Handle);

end;

のように呼び出します。 元ねたはRaymond ChenさんのHow do I prevent users from pinning my program to the taskbar? - The Old New Thing - Site Home - MSDN Blogs。