この発言に対し以下のコメントが寄せられています

#01284　Wacky           さん　RE:PopupMenuにデスクトップ項目を列挙2




こんにちは。Wackyです。前の発言の続きです。

//------------------------------------------------------------------------
//  親メニュー項目と同じ項目を挿入する
//------------------------------------------------------------------------
procedure TForm1.InsertParentFolder(var MenuItem: TMenuItem);
var
  NewMenuItem: TMenuItem;
begin
  NewMenuItem := TMenuItem.Create(Self);
  MenuItem.Insert(0, NewMenuItem);
  with NewMenuItem do begin
    ImageIndex := Parent.ImageIndex;
    Caption := Parent.Caption;
    OnClick := PopUpMenuClick;
    Tag := Parent.Tag;
  end;
  NewMenuItem := TMenuItem.Create(Self);
  MenuItem.Insert(1, NewMenuItem);
  with NewMenuItem do begin
    Caption := '-';
  end;
end;
//------------------------------------------------------------------------
//  関連付け実行(パスから)
//------------------------------------------------------------------------
procedure TForm1.FileExec(strFileName: String);
var
  ret: Integer;
  msg: string;
begin
  ret := ShellExecute(Self.Handle, nil, PChar(strFileName),
      nil, nil, SW_SHOWNORMAL);
  case ret of
  0:
    msg := 'The operating system is out of memory or resources.';
  ERROR_BAD_FORMAT:
    msg := 'The .EXE file is invalid ' +
           '(non-Win32 .EXE or error in .EXE image).';
  SE_ERR_ACCESSDENIED:
    msg := 'The operating system denied access to the specified file.';
  SE_ERR_ASSOCINCOMPLETE:
    msg := 'The filename association is incomplete or invalid.';
  SE_ERR_DDEBUSY:
    msg := 'The DDE transaction could not be completed ' +
           'because other DDE transactions were being processed.';
  SE_ERR_DDEFAIL:
    msg := 'The DDE transaction failed.';
  SE_ERR_DDETIMEOUT:
    msg := 'The DDE transaction could not be completed ' +
           'because the request timed out.';
  SE_ERR_DLLNOTFOUND:
    msg := 'The specified dynamic-link library was not found.';
  SE_ERR_FNF:
    msg := 'The specified file was not found.';
  SE_ERR_NOASSOC:
    msg := 'There is no application associated ' +
           'with the given filename extension.';
  SE_ERR_OOM:
    msg := 'There was not enough memory to complete the operation.';
  SE_ERR_PNF:
    msg := 'The specified path was not found.';
  SE_ERR_SHARE:
    msg := 'A sharing violation occurred.';
  end;
  if msg <> '' then ShowMessage(msg);
end;
//------------------------------------------------------------------------
//  関連付け実行(PItemIDから)
//------------------------------------------------------------------------
procedure TForm1.FileExecEx(pidl: PItemIDList);
var
  ShellExecuteInfo: TShellExecuteInfo;
  Path : array [0..MAX_PATH] of Char;
begin
  // 通常のパスに変換できる場合は変換して ShellExecute で実行する。
  // Win2k でデスクトップにエクスプローラのショートカットがある場合、
  // ShellExecuteEx に PItemIDList を渡して起動するとマイコンピュータが
  // 開いてしまうため
  if SHGetPathFromIDList(pidl, Path) = True then begin
    FileExec(String(Path));
  end
  else begin
    FillChar(ShellExecuteInfo, SizeOf(TShellExecuteInfo), 0);
    with ShellExecuteInfo do begin
      cbSize       := SizeOf(TShellExecuteInfo);
      fMask        := SEE_MASK_INVOKEIDLIST;
      wnd          := Self.Handle;
      lpVerb       := '';
      lpFile       := nil;
      lpParameters := '';
      lpDirectory  := '';
      nShow        := SW_SHOWNORMAL;
      hInstApp     := 0;
      lpIDList     := pidl;
      lpClass      := nil;
      hkeyClass    := 0;
      dwHotKey     := 0;
      hIcon        := 0;
    end;
    ShellExecuteEx(@ShellExecuteInfo);
  end;
end;
//------------------------------------------------------------------------
//  プロパティを開く(ごみ箱用）
//------------------------------------------------------------------------
procedure TForm1.OpenProperty(pPath: PChar; isFile: Boolean);
var
  ShellExecuteInfo: TShellExecuteInfo;
begin
  FillChar(ShellExecuteInfo, SizeOf(TShellExecuteInfo), 0);
  with ShellExecuteInfo do begin
    cbSize       := SizeOf(TShellExecuteInfo);
    fMask        := SEE_MASK_INVOKEIDLIST;
    wnd          := Self.Handle;
    lpVerb       := 'properties';
    lpParameters := '';
    lpDirectory  := '';
    nShow        := SW_SHOWNORMAL;
    hInstApp     := 0;
    lpClass      := nil;
    hkeyClass    := 0;
    dwHotKey     := 0;
    hIcon        := 0;
    if isFile then
      lpFile := pPath
    else
      lpIDList := pPath;
  end;
  ShellExecuteEx(@ShellExecuteInfo);
end;
//------------------------------------------------------------------------
//  メニューアイテムのクリックイベント
//------------------------------------------------------------------------
procedure TForm1.PopupMenuClick(Sender: TObject);
var
  ParentItemPIDL, BucketID: PItemIDList;
begin
  // ごみ箱のPItemIDListを取得
  OleCheck(SHGetSpecialFolderLocation(Handle, CSIDL_BITBUCKET, BucketID));
  // 親メニューのPItemIDListを取得
  ParentItemPIDL := IDlist[(Sender as TMenuItem).Parent.Tag];
  // 親メニューがごみ箱ならプロパティを表示
  if DesktopShellFolder.CompareIDs(0, ParentItemPIDL, BucketID) = 0 then
    OpenProperty(Pchar(IDlist[(Sender as TMenuItem).Tag]), False)
  else
    FileExecEx(IDlist[(Sender as TMenuItem).Tag]);
end;
//------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
  DesktopPIDL: PItemIDList;
  sfi: TSHFileInfo;
  Icon: TIcon;
  DesktopIconIndex: Integer;
  DesktopItems: TMenuItem;
begin
  IDlist := TList.Create;
  Self.PopupMenu := PopupMenu1;
  PopupMenu1.Images := ImageList1;
  // IMalloc インターフェースを取得してメモリをアロケート
  OleCheck(ShGetMalloc(Malloc));
  // デスクトップの IShellFolder インターフェースを取得
  OleCheck(SHGetDesktopFolder(DesktopShellFolder));
  Icon := TIcon.Create;
  try
    // デスクトップのアイコンと表示名を取得
    OleCheck(SHGetSpecialFolderLocation(Handle,
        CSIDL_DESKTOP, DesktopPIDL));
    SHGetFileInfo(PChar(DesktopPIDL), 0, sfi, SizeOf(TSHFileInfo),
        SHGFI_PIDL or SHGFI_ICON or SHGFI_SMALLICON or SHGFI_DISPLAYNAME);
    Icon.Handle := sfi.hIcon;
    DesktopIconIndex := ImageList1.AddIcon(Icon);
    // メニューを作成してアイコン・キャプション・PItemIDListを保存
    DeskTopItems := TMenuItem.Create(Self);
    with DeskTopItems do begin
      Caption := String(sfi.szDisplayName);
      ImageIndex := DesktopIconIndex;
      Tag := IDlist.Add(DesktopPIDL);
    end;
    // デスクトップ直下のアイテムを取得
    GetDesktopItems(DesktopItems);
    PopupMenu1.Items.Insert(0, DesktopItems);
  finally
    Icon.ReleaseHandle;
    Icon.Free;
  end;
end;
//------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to IDlist.Count - 1 do begin
    if Assigned(IDlist[i]) then Malloc.Free(IDlist[i]);
  end;
  IDlist.Free;
end;
//------------------------------------------------------------------------
initialization
begin
  OleCheck(OleInitialize(nil));
  Malloc := nil;
end;

finalization
begin
  OleUnInitialize;
end;

end.

 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/02/18 -

Original document by Wacky           氏 ID:(HQL05475)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。