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。
0 件のコメント:
コメントを投稿