Recent

Author Topic: TShellTreeView popup menu  (Read 3229 times)

netuddki76

  • Newbie
  • Posts: 2
TShellTreeView popup menu
« on: July 26, 2016, 11:34:40 am »
I have a TShellTreeView and I would that right-clicking an item in it to bring up the Windows Explorer's right-click context menu. What I have to do?

Ondrej Pokorny

  • Full Member
  • ***
  • Posts: 220
Re: TShellTreeView popup menu
« Reply #1 on: July 26, 2016, 04:11:09 pm »
Search in google. There are some ready-to-go solutions.

netuddki76

  • Newbie
  • Posts: 2
Re: TShellTreeView popup menu
« Reply #2 on: July 27, 2016, 04:00:56 pm »
Found some stuff for Delphi only. Can someone help with some for Lazarus?

ASerge

  • Hero Member
  • *****
  • Posts: 2223
Re: TShellTreeView popup menu
« Reply #3 on: August 06, 2016, 06:26:28 pm »
Sample
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, ShellCtrls, Messages, ShlObj;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     ShellTreeView1: TShellTreeView;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure ShellTreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  18.       Shift: TShiftState; X, Y: Integer);
  19.   private
  20.     FICM2: IContextMenu2;
  21.     FICM3: IContextMenu3;
  22.     procedure DoExplorerContextMenu(ScreenPos: TPoint; const Path: string);
  23.   protected
  24.     procedure WndProc(var Message: TMessage); override;
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. implementation
  31.  
  32. {$R *.lfm}
  33.  
  34. uses Windows;
  35.  
  36. function GetItemIdList(const InFolder: IShellFolder;
  37.   const ByFileName: string; out ToItem: PItemIdList): Boolean;
  38. begin
  39.   Result := (InFolder <> nil) and (ByFileName <> '') and
  40.     (InFolder.ParseDisplayName(0, nil, Pointer(WideString(ByFileName)),
  41.       ULONG(nil^), ToItem, ULONG(nil^)) = S_OK);
  42. end;
  43.  
  44. function GetContextMenu(const Path: string; out Menu: IContextMenu): Boolean;
  45. var
  46.   PathAsDir, ParentPath: string;
  47.   Desktop, Parent: IShellFolder;
  48.   P: PItemIdList;
  49. begin
  50.   Result := False;
  51.   PathAsDir := ExcludeTrailingPathDelimiter(Path);
  52.   if DirectoryExists(PathAsDir) then
  53.   begin
  54.     ParentPath := ExtractFilePath(PathAsDir);
  55.     if (SHGetDesktopFolder(Desktop) = S_OK) and
  56.       GetItemIdList(Desktop, ParentPath, P) and
  57.       (Desktop.BindToObject(P, nil, IID_IShellFolder, Parent) = S_OK) and
  58.       GetItemIdList(Parent, ExtractFileName(PathAsDir), P) then
  59.     begin
  60.       Result := Parent.GetUIObjectOf(0, 1, P, IID_IContextMenu, nil, Menu) = S_OK;
  61.     end;
  62.   end;
  63. end;
  64.  
  65. procedure TForm1.FormCreate(Sender: TObject);
  66. begin
  67.   ShellTreeView1.Root := 'C:\';
  68.   ShellTreeView1.RightClickSelect := True;
  69. end;
  70.  
  71. procedure TForm1.ShellTreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  72.   Shift: TShiftState; X, Y: Integer);
  73. begin
  74.   if Button = mbRight then
  75.   begin
  76.     DoExplorerContextMenu(ShellTreeView1.ClientToScreen(Classes.Point(X, Y)),
  77.       ShellTreeView1.Path);
  78.   end;
  79. end;
  80.  
  81. procedure TForm1.DoExplorerContextMenu(ScreenPos: TPoint; const Path: string);
  82. var
  83.   ICM: IContextMenu;
  84.   SysMenu: HMenu;
  85.   Ok: LongBool;
  86.   Info: ShlObj.TCMInvokeCommandInfo;
  87. begin
  88.   if not GetContextMenu(Path, ICM) then
  89.     Exit;
  90.   SysMenu := CreatePopupMenu;
  91.   try
  92.     if not Succeeded(ICM.QueryContextMenu(SysMenu, 0, 1, $7FFF, CMF_EXPLORE)) then
  93.       Exit;
  94.     try
  95.       ICM.QueryInterface(IContextMenu3, FICM3); // For submenus
  96.       if not Assigned(FICM3) then
  97.         ICM.QueryInterface(IContextMenu2, FICM2); // For submenus
  98.       Ok := TrackPopupMenu(SysMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
  99.         TPM_RIGHTBUTTON or TPM_RETURNCMD, ScreenPos.X, ScreenPos.Y, 0,
  100.         Handle, nil);
  101.     finally
  102.       FICM2 := nil;
  103.       FICM3 := nil;
  104.     end;
  105.     if Ok then
  106.     begin
  107.       ZeroMemory(@Info, SizeOf(Info));
  108.       with Info do
  109.       begin
  110.         cbSize := SizeOf(Info);
  111.         hWND := Handle;
  112.         lpVerb := MakeIntResource(LongInt(Ok) - 1);
  113.         nShow := SW_SHOWNORMAL;
  114.       end;
  115.       ICM.InvokeCommand(Info);
  116.     end;
  117.   finally
  118.     DestroyMenu(SysMenu);
  119.   end;
  120. end;
  121.  
  122. procedure TForm1.WndProc(var Message: TMessage);
  123. begin
  124.   with Message do
  125.     if Assigned(FICM3) then
  126.     begin
  127.       if FICM3.HandleMenuMsg2(Msg, WParam, LParam, @Result) = S_OK then
  128.         Exit;
  129.     end
  130.     else
  131.       if Assigned(FICM2) then
  132.       begin
  133.         if FICM2.HandleMenuMsg(Msg, WParam, LParam) = S_OK then
  134.           Exit;
  135.       end;
  136.   inherited;
  137. end;
  138.  
  139. end.
  140.  

 

TinyPortal © 2005-2018