unit UnitTaskArray;
interface
uses Classes, UnitMiscCom, ShlObj, Windows, ActiveX;
{$REGION 'PURPOSE'}
{
Utiltiy class to support JumpLists.
}
{$ENDREGION}

type TTaskArray = class(TInterfacedObject, IObjectArray)
    private
        FObjectList : TInterfaceList;
    protected
        procedure AddShellLink(sl : IShellLinkW); overload;
    public
        constructor Create();
        destructor Destroy; override;

    procedure AddShellLink(DisplayName : string;
        Arguments : string;
        IconFilename : string = ''; IconIndex : integer = 0); overload;

    function GetAt(uiIndex: Cardinal; riid: PGUID): IUnknown; safecall;
    function GetCount: Cardinal; safecall;
  end;

implementation

uses Forms, SysUtils, winapi.propsys;

function CreateShellLink(
    DisplayName : string;
    Arguments : string;
    IconFilename : string = ''; IconIndex : integer = 0
): IShellLinkW;
var
    key   : TPropertyKey;
    prop   : tagPROPVARIANT;
    i : integer;
    function ToPWide(s : string) : PWideChar;
    begin
        result := PWideChar(WideString(s));
    end;
begin
    if not
        CoCreateInstance(
        CLSID_ShellLink, nil,
        CLSCTX_INPROC_SERVER, IID_IShellLinkW,
        result
        ) = S_OK then begin
        EXIT;
    end;

    result.SetPath(ToPWide(Application.EXEName));
    result.SetArguments(ToPWide(Arguments));

    if (IconFilename <> '') then begin
        i := result.SetIconLocation(ToPWide(IconFilename), IconIndex);
        if not (i = S_OK) then begin
            DisplayName := 'NotOk';
        end;
    end else begin
        //result.SetIconLocation(ToPWide(Application.EXEName), 0);
        result.SetIconLocation('', 0);
    end;

    // Separator Line, or Title string
    if DisplayName = '-' then begin
        prop.vt := VT_BOOL;  // set the type
        prop.bool := true;   // set the data

        key.fmtid := StringToGUID('{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}'); // PKEY_AppUserModel_IsDestListSeparator
        key.pid := 6;                                                        //

        with result as winapi.propsys.IPropertyStore do begin
            SetValue(key, prop);
            Commit;
        end;
    end else begin

        prop.vt := VT_LPWSTR;                 // set the type
        prop.pwszVal := ToPWide(DisplayName); // set the data

        key.fmtid := StringToGUID('{F29F85E0-4FF9-1068-AB91-08002B27B3D9}'); // PKEY_Title property
        key.pid := 2;                                                        //

        with result as IPropertyStore do begin
            SetValue(key, prop);
            Commit;
        end;
    end;
end;

{ TShellLinkArray }

procedure TTaskArray.AddShellLink(sl: IShellLinkW);
begin
    FObjectList.Add(sl);
end;

procedure TTaskArray.AddShellLink(DisplayName, Arguments, IconFilename: string;
  IconIndex: integer);
begin
    self.AddShellLink( CreateShellLink(DisplayName, Arguments, IconFilename, IconIndex) );
end;

constructor TTaskArray.Create;
begin
    inherited Create;
    FObjectList := TInterfaceList.Create;
end;

destructor TTaskArray.Destroy;
begin
    FObjectList.Free;
    inherited;
end;

function TTaskArray.GetAt(uiIndex: Cardinal; riid: PGUID): IUnknown;
begin
    result := nil;
    if uiIndex >= FObjectList.Count then EXIT;

    result := FObjectList[uiIndex];
end;

function TTaskArray.GetCount: Cardinal;
begin
    result := FObjectList.Count;
end;



end.
