ジャンプリストを使ってみる その２

前回の続き、今回はジャンプリストにタスクを追加してみます。

  // Task/Destination作成用データを保持する
  TTaskItem = class
  protected
    function CreateShellLink(out AShellLink: IShellLink): Boolean;
  public
    constructor Create; overload;
    constructor Create(APath, ATitle, AArgument: string); overload;
    function CreateObject(out AShellObject: IUnknown): Boolean;
    property Argument: string read FArgument write SetArgument;
    property Description: string read FDescription write SetDescription;
    property IconIndex: Integer read FIconIndex write SetIconIndex;
    property IconLocation: string read FIconLocation write SetIconLocation;
    property Path: string read FPath write SetPath;
    property Title: string read FTitle write SetTitle;
  end;

function TTaskItem.CreateObject(out AShellObject: IUnknown): Boolean;
var
  SL: IShellLink;
  SI: IShellItem;
begin
  AShellObject := nil;

  if FArgument <> '' then
  begin
    // 引数が空で無ければ IShellLink を作成
    if CreateShellLink(SL) then
    begin
      AShellObject := SL as IUnknown;
    end;
  end
  else if FPath <> '' then
  begin
    // ファイルパスが設定されてれば IShellItem を作成
    if CreateShellItem(SI) then
    begin
      AShellObject := SI as IUnknown;
    end;
  end else begin
    // どちらも空の場合はセパレータを作成
    if CreateSeparatorLink(SL) then
    begin
      AShellObject := SL as IUnknown;
    end;
  end;
  Result := Assigned(AShellObject);
end;

// IShellLinkを作成するメソッド
function TTaskItem.CreateShellLink(out AShellLink: IShellLink): Boolean;
var
  HR:      HRESULT;
  SL:      IShellLink;
  PS:      IPropertyStore;
  Propvar: TPropVariant;
begin
  Result := False;

  HR := E_FAIL;
  if Succeeded(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
      IID_IShellLink, SL)) then
  begin
    // Pathの設定
    if Failed(SL.SetPath(PChar(FPath))) then
      Exit;
    // 引数の設定
    if Failed(SL.SetArguments(PChar(FArgument))) then
      Exit;
    // 説明の設定 
    if (FDescription <> '') and
      Failed(SL.SetDescription(PChar(FDescription))) then
      Exit;
    // アイコンの設定
    if (FIconLocation <> '') and Failed(SL.SetIconLocation(PChar(FIconLocation),
        FIconIndex)) then
      Exit;
    // ジャンプリストのタイトルの設定
    if Succeeded(SL.QueryInterface(IID_IPropertyStore, PS)) then
    begin
      if Succeeded(InitPropVariantFromString(FTitle, Propvar)) then
      begin
        if Succeeded(PS.SetValue(PKEY_Title, Propvar)) then
        begin
          HR := PS.Commit;
        end;
        PropVariantClear(Propvar);
      end;
    end;
    if Succeeded(HR) then
    begin
      Result := Succeeded(SL.QueryInterface(IID_IShellLink, AShellLink));
    end;
  end;
end;

function TTaskItem.CreateSeparatorLink(out AShellLink: IShellLink): Boolean;
var
  PS:      IPropertyStore;
  Propvar: TPropVariant;
begin
  Result := False;
  if Succeeded(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
      IID_IPropertyStore, PS)) then
  begin
    if Succeeded(InitPropVariantFromBoolean(True, Propvar)) then
    begin
      if Succeeded(PS.SetValue(PKEY_AppUserModel_IsDestListSeparator,
          Propvar)) then
      begin
        if Succeeded(PS.Commit) then
        begin
          Result := Succeeded(PS.QueryInterface(IID_IShellLink, AShellLink));
        end;
      end;
      PropVariantClear(Propvar);
    end;
  end;
end;

TTaskItemは、ジャンプリストのアイテムを作成・データ保持をするクラスです。
CreateObjectメソッドで、Argumentが設定されている場合は、IShellLinkをArgumentが空でPathが設定されていればIShellItemをどちらも空の場合はセパレータを作成します。

  TTaskList = TObjectList<TTaskItem>;

  TJumplist = class
  private
    function AddCategoryToList(CategoryName: string; oaRemoved: IObjectArray;
      List: TTaskList; CDL: ICustomDestinationList): Boolean;
    function AddTasksToList(List: TTaskList;
      CDL: ICustomDestinationList): Boolean;
    function GetCategories(ACategory: string): TTaskList;
    function IsItemInArray(ASI: IShellItem; oaRemoved: IObjectArray)
      : Boolean; overload;
    function IsItemInArray(Item: TTaskItem; oaRemoved: IObjectArray)
      : Boolean; overload;
  public
    constructor Create(const AAppID: string);
    destructor Destroy; override;
    function CreateJumpList: Boolean;
    procedure DeleteJumpList;
    property AppID: string read FAppID;
    property Categories[ACategory: string]: TTaskList read GetCategories;
    property Tasks: TTaskList read FTasks;
  end;

function TJumplist.AddTasksToList(List: TTaskList;
  CDL: ICustomDestinationList): Boolean;
var
  OC:   IObjectCollection;
  Item: TTaskItem;

  OA: IObjectArray;
  UK: IUnknown;
begin
  Result := False;
  if Succeeded(CoCreateInstance(CLSID_EnumerableObjectCollection, nil,
      CLSCTX_INPROC, IID_IObjectCollection, OC)) then
  begin
    for Item in List do
    begin
      if Item.CreateObject(UK) then
        OC.AddObject(UK);
    end;

    if Succeeded(OC.QueryInterface(IID_IObjectArray, OA)) then
    begin
      Result := Succeeded(CDL.AddUserTasks(OA));
    end;
  end;
end;

TJumplistは、TTaskItemのリストを保持しジャンプリストを作成するクラスです。TasksがカスタムタスクをCategoriesがカスタムカテゴリを保持します。TJumplist.TasksにTTaskItemを追加した後、CreateJumpListを呼び出したらカスタムタスクを追加したジャンプリストを作成します。
TJumplist.Create 時にAppIDを引数として渡します。これは、SetCurrentProcessExplicitAppUserModelIDで設定したAppIDと同じものを設定します。

procedure TForm1.Button1Click(Sender: TObject);
var
  JL: TJumplist;

  Task: TTaskItem;
begin
  SetCurrentProcessExplicitAppUserModelID('AU2010.Samples.JumplistTest');

  // Windows7の時だけ実行する
  if CheckWin32Version(6, 1) then
  begin
    JL := TJumplist.Create('AU2010.Samples.JumplistTest');
    Task := TTaskItem.Create;
    Task.Path := Application.ExeName;
    Task.Argument := '/ARG1';
    Task.IconLocation := Application.ExeName;
    Task.IconIndex := 0;
    Task.Title := 'TEST1';
    JL.Tasks.Add(Task);
    Task := TTaskItem.Create;
    Task.Path := Application.ExeName;
    Task.Argument := '/ARG2';
    Task.Title := 'TEST2';
    JL.Tasks.Add(Task);

    JL.CreateJumpList;
    FreeAndNil(JL);
  end;
end;

作成したジャンプリストは下図になります。

次は、カスタムカテゴリを追加してみようと思います。