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

#01291　アイクビー      さん　シェルのツリーを表示(2/2)






もう何度も話題になっていますが、シェルのネーム スペースからツリーを表示
する方法です。オブジェクトの名前とアイコンをツリー表示する以外は何もしな
いので、ネーム スペースへのアクセスを理解する参考にするには手ごろではな
いかと思い、アップすることにしました。

APIとかCOMの使い方は一応ヘルプに従っているつもりですが、間違いや改善のご
指摘をいただければ幸いです。動作は、Windows 2000 + SP1とWindows 95(A) + 
SP1でオッケーでした。デスクトップ以下、全部表示できるようです。コードが
300行を越えるので、この発言へのレスに続きを入れておきます。

5タブ(笑)とか見慣れない変数名のつけ方で見づらいとは思いますが、ご容赦く
ださいまし。フォーム(Form1)のOnCreateをFormCreateに、OncloseをFormClose
に設定し、TTreeView（TreeView1)を乗せて、OnExpandingをTreeView1Expanding
に設定すると動くと思います。

(ここから)

uses
  ..., CommCtrl, ShellAPI, ShlObj, ActiveX;

type
//   ノードの情報(TTreeNode.Data)
     PTreeNodeData = ^TTreeNodeData;
     TTreeNodeData = record
          fFolder:  IShellFolder;       // nil: フォルダー以外
          fIDList:  PItemIDList;        // 親ノードからの相対
          fExpand:  Boolean;            // True: Enum済み
     end;

//**********************************************************************
//   TForm1:   フォームの消滅
//**********************************************************************
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
     i:   Integer;

begin
     for i := 0 to TreeView1.Items.Count - 1 do begin
          with TreeView1.Items[i] do begin
               if Assigned(PTreeNodeData(Data).fFolder) then begin
                    PTreeNodeData(Data).fFolder._Release();
               end;
               FfMalloc.Free(PTreeNodeData(Data).fIDList);
               Dispose(PTreeNodeData(Data));
          end;
     end;

     FfIcon._Release();
     FfFolder._Release();
     FfMalloc._Release();
end;

//**********************************************************************
//   TForm1:   フォームの生成
//**********************************************************************
procedure TForm1.FormCreate(Sender: TObject);
var
     hRE: HRESULT;
     fII: PItemIDList;
     hIL: HImageList;
     fFI: TSHFileInfo;
     fTN: TTreeNode;
     fND: PTreeNodeData;

begin
     hRE  := SHGetMalloc(FfMalloc);
     if not (hRE = NOERROR) then begin
          ShowMessage('SHGetMalloc: '+IntToHex(hRE, 8));

          Exit;
     end;
     FfMalloc._AddRef();

     hRE  := SHGetDesktopFolder(FfFolder);
     if not (hRE = NOERROR) then begin
          ShowMessage('SHGetDesktopFolder: '+IntToHex(hRE, 8));

          Exit;
     end;
     FfFolder._AddRef();

     hRE  := FfFolder.QueryInterface(IID_IShellIcon, FfIcon);
     if not (hRE = NOERROR) then begin
          ShowMessage('IShellFolder.QueryInterface: '+IntToHex(hRE, 8));

          Exit;
     end;
     FfIcon._AddRef();

     hRE  := SHGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, fII);
     if not (hRE = NOERROR) then begin
          ShowMessage('SHGetSpecialFolderLocation: '+IntToHex(hRE, 8));

          Exit;
     end;

     hIL  := SHGetFileInfo(
          PAnsiChar(fII), 0, fFI, SizeOf(TSHFileInfo),
          SHGFI_PIDL or SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX
     or   SHGFI_SMALLICON
     );
     if (hIL = 0) then begin
          FfMalloc.Free(fII);
          ShowMessage(
               'SHGetFileInfo: '+SysErrorMessage(GetLastError())
          );

          Exit;
     end;

     TreeView1.Images    := TImageList.Create(TreeView1);
     TreeView1.Images.ShareImages  := True;
     TreeView1.Images.Handle       := hIL;

     New(fND);
     fND.fFolder    := FfFolder;
     fND.fIDList    := fII;
     fND.fExpand    := False;

     fTN  := TreeView1.Items.AddChildObject(
          nil, fFI.szDisplayName, fND
     );

     fTN.OverlayIndex    := -1;
     fTN.HasChildren     := True;
     fTN.ImageIndex      := fFI.iIcon;
     fTN.SelectedIndex   := fFI.iIcon;
end;

//**********************************************************************
//   TForm1:   ノードを展開する
//**********************************************************************
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);

//   *******************************************************************
//   アイコンのインデックスを設定する(ファイル システム)
//   *******************************************************************
     function  SetIconIndex(
          fNode:    TTreeNode
     ): Boolean;
     var
          iSI: Integer;

     begin
          Result    := True;

          if (FfIcon.GetIconOf(
               PTreeNodeData(fNode.Data).fIDList, GIL_FORSHELL, iSI
          ) = NOERROR) then begin
               fNode.ImageIndex    := iSI;
          end
          else begin
               Result    := False;
          end;

          if (FfIcon.GetIconOf(
               PTreeNodeData(fNode.Data).fIDList, GIL_OPENICON, iSI
          ) = NOERROR) then begin
               fNode.SelectedIndex := iSI;
          end
          else begin
               Result    := False;
          end;
     end;

//   *******************************************************************
//   アイコンのインデックスを設定する(仮想、リンク フォルダー用)
//   *******************************************************************
     procedure SetIconIndexOf(
          fNode:    TTreeNode;
          fList:    PItemIDList
     );
     var
          fFI: TSHFileInfo;

     begin
          if (SHGetFileInfo(
               PAnsiChar(fList), 0, fFI, SizeOf(TSHFileInfo),
               SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON
          ) = 0) then begin
               ShowMessage(
                    'SHGetFileInfo: '+SysErrorMessage(GetLastError())
               );

               Exit;
          end
          else begin
               fNode.ImageIndex    := fFI.iIcon;
          end;

          if (SHGetFileInfo(
               PAnsiChar(fList), 0, fFI, SizeOf(TSHFileInfo),
               SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON
          or   SHGFI_SELECTED
          ) = 0) then begin
               ShowMessage(
                    'SHGetFileInfo: '+SysErrorMessage(GetLastError())
               );

               Exit;
          end
          else begin
               fNode.SelectedIndex := fFI.iIcon;
          end;
     end;

(続く)

アイクビー
 


Original document by アイクビー      氏 ID:(KHB01350)

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