{  在自己的界面中弹出系统右键菜单。}

unit PopupShell;

interface

uses
  Windows, Messages, SysUtils, StrUtils, ComObj,
  ShlObj,
  ActiveX;

function DisplayContextMenu(const Handle: THandle; const FileName: string;
  Pos: TPoint): Boolean;

implementation

type
  TUnicodePath = array[0..MAX_PATH - 1] of WideChar;

const
  ShenPathSeparator = '\';

//=============================================================================

//返回IDList去掉第一个ItemID后的IDList
  function NextPIDL(IDList: PItemIDList): PItemIDList;
  begin
　　Result := IDList;
　　Inc(PChar(Result), IDList^.mkid.cb);
  end;

//返回IDList的长度
  function GetPIDLSize(IDList: PItemIDList): Integer;
  begin
　　Result := 0;
　　if Assigned(IDList) then
　　begin
  　　Result := SizeOf(IDList^.mkid.cb);
  　　while IDList^.mkid.cb <> 0 do
  　　begin
    　　Result := Result + IDList^.mkid.cb;
    　　IDList := NextPIDL(IDList);
  　　end;
　　end;
  end;

//取得IDList中ItemID的个数
  function GetItemCount(IDList: PItemIDList): Integer;
  begin
　　Result := 0;
　　while IDList^.mkid.cb <> 0 do
　　begin
  　　Inc(Result);
  　　IDList := NextPIDL(IDList);
　　end;
  end;

//创建一ItemIDList对象
  function CreatePIDL(Size: Integer): PItemIDList;
  var
　　Malloc: IMalloc;
  begin
　　OleCheck(SHGetMalloc(Malloc));

Result := Malloc.Alloc(Size);
　　if Assigned(Result) then
  　　FillChar(Result^, Size, 0);
  end;

//返回IDList的一个内存拷贝
  function CopyPIDL(IDList: PItemIDList): PItemIDList;
  var
　　Size: Integer;
  begin
　　Size := GetPIDLSize(IDList);
　　Result := CreatePIDL(Size);
　　if Assigned(Result) then
  　　CopyMemory(Result, IDList, Size);
  end;

//返回AbsoluteID最后一个ItemID，即此对象相对于父对象的ItemID
  function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;
  begin
　　Result := AbsoluteID;
　　while GetItemCount(Result) > 1 do
   　　Result := NextPIDL(Result);
　　Result := CopyPIDL(Result);
  end;

//将IDList的最后一个ItemID去掉，即得到IDList的父对象的ItemID
  procedure StripLastID(IDList: PItemIDList);
  var
　　MarkerID: PItemIDList;
  begin
　　MarkerID := IDList;
　　if Assigned(IDList) then
　　begin
  　　while IDList.mkid.cb <> 0 do
  　　begin
    　　MarkerID := IDList;
    　　IDList := NextPIDL(IDList);
  　　end;
  　　MarkerID.mkid.cb := 0;
　　end;
  end;