ContextMenuHandlers in eigene PopupMenüs einbinden

[franz]

Derzeit arbeite ich an einem Explorer. Dabei ist folgendes Problem aufgetreten.
:( Ich möchte, wie der Windows Explorer, Context Menu Handlers in mein PopupMenu einbinden. Allerdings ist bisher jeder Versuch gescheitert.

Über die CLSID des Handlers erhalte ich die dazugehörige DLL. Nun folgendes Problem. Zur Entwurfszeit ist es wunderbar möglich Funktionen aus DLLs einzubinden. Aber die DLL ist erst zur Laufzeit bekannt.

Es geht mir nur um die Einbindung der Context Menu Handlers. Der übrige Teil des Menüs, der auf der Dateitypdeklaration basiert, ist kein Problem.

Meine Fragen:
1. Wie werden Funktionen aus DLLs zur Laufzeit eingebunden?
2. Kann ich die folgende Funktion verwenden, um die Menüeinträge aus der DLL in mein Menü einzubinden?

Delphi-Quellcode:

function QueryContextMenu(const IMenu: IContextMenu; Menu: HMENU;
 ixMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall; external 'Pfad der DLL';

Vielleicht weiß es jemand?

[cheatzs]

Hi.
kenn mich nich so wahnsinnig gut mit DLL's aus, auf jeden Fall findest du hier ein gutes Tutorial für dynamische Einbindung von DLLs: http://www.luckie-online.de/tutorials/assarbad/

Ist allerdings etwas komplizierter als die statische Einbindung.

Auf die 2. Frage weiß ich keinen Rat, wie gesagt, kenn mich nich so aus in dem Bereich, wollt bloß schnell ne Ansatz für dich schreiben :wink:

Viel Glück :thuimb:

[franz]

:thuimb: Danke für den Tipp.

Das dynamische Einbinden von DLLs ist jetzt kein Problem mehr. Doch die Erstellung des Menüs, abhängig vom Handler, funktioniert noch nicht.

:gruebel: Beim Aufruf von GetProcAdress wird immer nil zurückgegeben.

Ich habe folgendes geschrieben:

Delphi-Quellcode:

type
  TFNCreateMenuItems = function (Menu: HMENU; indexMenu, idCmdFirst, 
    uFlags: UINT): HResult;

var
  CreateMenuItems: TFNCreateMenuItems;

var
  libHandle: THandle;
begin
  libHandle := LoadLibrary(PChar('C:\PROGRAMME\ULTIMATEZIP\UZSHLEX.DLL'));
  if libHandle <> 0 then
     begin
       @CreateMenuItems := GetProcAddress(libHandle,PChar('QueryContextMenu'));
       if @CreateMenuItems <> nil then
          begin
            CreateMenuItems(PopupMenu1.Handle,0,0,0,CMF_NORMAL);
            PopupMenu1.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y);
          end
       else
         ShowMessage('Fehler (@CreateMenuItems = nil): ' + IntToStr(GetLastError));
     end
  else
    ShowMessage('Fehler (libHandle = 0): ' + IntToStr(GetLastError));
  FreeLibrary(libHandle);
end;

[franz]

Klar, dass das obere Beispiel nicht funktioniert.
ContextMenuHandler DLLs exportieren die notwendigen Funktionen nicht! Wäre ja auch viel zu einfach.

Werde es mal über die Schnittstellen IShellExtInit und IContextMenu versuchen. Irgendwie muss der Windows Explorer das auch hinkriegen.

[franz]

Noch einmal zu meiner Frage:
Wie kann ich Context Menu Handler in eigenen PopupMenüs verwenden?
Mein größtes Problem ist es einen geeigneten Ansatz zu finden.

Bisher habe ich folgendes geschrieben:

Delphi-Quellcode:

const
  GUID: TGUID = '{2F860D81-AF3C-11D4-BDB3-00E0987D8540}'; // CLSID des Handlers
var
  Handler: Variant;
begin
  Handler := CreateComObject(GUID);
  Handler.QueryContextMenu(PopupMenu1.Handle,0,0,0, CMF_NORMAL); // Fehler an dieser Stelle
end;

Allerdings hat diese nichts geholfen. Ich erhalte jetzt die Fehlermeldung „Variante referenziert kein Automatisierungsobjekt“. Könnte das daran liegen, dass CreateComObject eine IUnknown Schnittstelle zurückgibt?

[franz]

Ich habe jetzt eine halbwegs akzeptable Lösung, die auf dem Source von edosoft aufbaut. Allerdings funktioniert diese noch nicht richtig.

Weiteres in Kürze.

[franz]

Nachtrag:
Ich habe jetzt das selbe Problem, das edosoft hatte.

Da ich allerdings mit Delphi5 arbeite steht mir die Unit ShellCtrls nicht zur Verfügung.

[franz]

:coder: Bin jetzt etwas weiter.

Allerdings gibt es immer noch 5 Probleme.

:gruebel: 1. Problem
Die Menüeinträge, die vor dem Hinzufügen der Handler, sich im Menu befinden, reagieren auf die falschen Ereignisse. Wenn auf einen eigenen Menüeintrag geklickt wird, wird das Ereignis ausgelöst, das der zuletzt angeklickte Handler Menüeintrag ausgelöst hat.
Wenn noch kein Handler Menüeintrag angeklickt wurde, wird z. B. statt einen Dialog anzuzeigen, nach einer Diskette gefragt, die zugrundeliegende Datei gelöscht oder es geschieht gar nichts und das alles beim gleichen Menüeintrag. Dann kommt auch noch dazu, dass das falsche Ereignis bei allen eigenen Menüeinträgen auftritt. Wenn z. B. bei Menüeintrag „A“ eine Datei gelöscht wird, wird auch bei Menüeintrag „B“ eine Datei gelöscht u. s. w.

Ich habe folgende Liste aufgestellt, die die Rückgabewerte von mCmd in ContextMenuForFile enthält:

Zitat:

Virensuche 68
Zu Zip Archiv hinzufügen 67
Hinzufügen zu Zip 66
Zip und E-Mail 65
Senden an - Diskette 2
Senden an -Desktop Verknüpfung 2
Senden an - Eigene Dateien 2
Senden an - E-Mail Empfänger 2
Senden an - Web Publish Assistent 2

Eigener Menüeintrag „A“ 1
Eigener Menüeintrag „B“ 2

Natürlich kann man mCmd mit einer Case Anweisung abarbeiten und die notwendigen Ereignisse aufrufen. Allerdings gibt es nun wieder folgendes Problem. Der eigene Menüeintrag „B“ hat den gleichen Wert, wie die Menüeinträge des „Senden an“ Menüs. Dadurch werden die falschen Ereignisse für die Menüeinträge im „Senden an“ Menü aufgerufen.

Frage: Was muss man ändern, damit die richtigen Ereignisse aufgerufen werden?


:gruebel: 2. Problem (Dieses Problem tritt nur auf, wenn das Menü auf seine Handler beschränkt angezeigt wird (idCmdLast = 0))
Wenn das eigene PopupMenu Untermenüs enthält, tritt eine Zugriffsverletzung in „SHDOC401.dll“ auf, wenn die Maus auf den Menüeintrag geführt wird, der weitere Untereinträge enthält. Manchmal stürzt Windows ( 98 ) sogar mit einer schweren Ausnahmefehler ab.



:gruebel: 3. Problem (Dieses Problem tritt nur auf, wenn das Menü auf seine Handler beschränkt angezeigt wird (idCmdLast = 0))
Die Handler lassen sich nur an erster Stelle (0) in das Menü einfügen. Wenn die Handler an Stelle 1 eingefügt werden sollen, gerät die Menüordnung durcheinander und der erste eigene Menüeintrag „A“ löst sich im Nichts auf. Außerdem enthält der Menüeintrag „Senden an“ wieder den Eintrag „Senden an“. Wenn für den Index 2 oder eine höhere Zahl verwendet wird, tritt beim Anzeigen des Menüs eine Zugriffsverletzung auf.



:gruebel: 4. Problem
Die hinzugefügten Menüeinträge lassen sich nicht mehr entfernen. Sie verschwinden erst wieder, wenn das PopupMenu angezeigt wird, ohne die Handler Menüeinträge einzufügen. Wahrscheinlich wird dabei nicht einmal der belegte Speicherplatz der Handler Menüeinträge freigegeben.


:gruebel: 5. Problem (weniger wichtig)
Im Windows Explorer werden in der Statusleiste Hints zu den ausgewählten Menüeinträgen angezeigt. Dazu muss „GetCommandString“ aufgerufen werden. Allerdings liefert der Aufruf entweder einen leeren String, den Pfad der Ursprungsdatei oder sogar „C:\Server nicht gefunden!“. Auch zu Menüeinträgen, die bereits vorhanden sind und einen Hint besitzen, wird in der Statusleiste nichts angezeigt. Das liegt allerdings nicht daran, dass ich vergessen hätte „AutoHint“ auf true zu setzen. Außerdem weiß ich nicht, wann ich „GetCommandString“ aufrufen soll.


Ich habe bisher folgendes geschrieben (Auch wenn es noch unvorteilhaft aussieht – wird später geändert, wenn es endlich funktioniert, falls dies möglich ist):

Delphi-Quellcode:

uses ShellApi, ShlObj, ComObj, FileCtrl, ActiveX;
{$R *.DFM}

var
  mContextMenu:  IContextMenu;
  mContextMenu2: IContextMenu2;

function SHGetIDListFromPath(FileName: TFileName; var ShellFolder: IShellFolder): PItemIDList;
var
  sParseName: String;
  mTempPath, mNextDir: TFileName;
  iScanParam: Integer;
  iDidGet: Cardinal;
  mFolder, mSubFolder: IShellFolder;
  mPIDL, mPIDLbase: PItemIDList;
  mParseStruct: TStrRet;
  mEList: IEnumIDList;

  procedure GetDirs(var TempPath, NextDir: TFileName);
  var
    iSlashPos: Integer;

    function SlashDirName(ADir: String): String;
    var
      S: String;
      RootDir: Boolean;
    begin
      if ADir <> '' then
         begin
           S := ADir;
           RootDir := ((Length(S)=3) and (S[2]=':')) or (S='\');
           if not RootDir then
              if S[Length(S)] <> '\' then
                 S := S + '\';
           Result := S;
         end;
    end;
  begin
    iSlashPos := Pos('\', TempPath);
    if iSlashPos > 0 then
       begin
         if Pos(':', TempPath) > 0 then
            NextDir := Copy(TempPath, 1, 3)
         else
           NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, iSlashPos - 1);
         TempPath := Copy(TempPath, iSlashPos + 1, Length(TempPath));
       end
    else
      begin
        if NextDir = '' then
           NextDir := TempPath
        else
          NextDir := SlashDirName(NextDir) + TempPath;
        TempPath := '';
      end;
  end;
begin
  SHGetDesktopFolder(mFolder);
  SHGetSpecialFolderLocation(0, CSIDL_DRIVES, mPIDLbase);

  OLECheck(mFolder.BindToObject(mPIDLbase, nil, IID_IShellFolder, Pointer(mSubFolder)));
  mTempPath := FileName;
  mNextDir  := '';

  while Length(mTempPath) > 0 do
    begin
      GetDirs(mTempPath,mNextDir);

      mPIDL := mPidlBase;
      iScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
      if (mNextDir = FileName) and (not DirectoryExists(FileName)) then
         iScanParam := iScanParam or SHCONTF_NONFOLDERS;

      if S_OK = mSubFolder.EnumObjects(0, iScanParam, mEList) then
         while S_OK = mEList.Next(1, mPIDL, iDidGet) do
           begin
             OLECheck(mSubFolder.GetDisplayNameOf(mPIDL, SHGDN_FORPARSING, mParseStruct));
             case mParseStruct.uType of
               STRRET_CSTR:   sParseName := mParseStruct.cStr;
               STRRET_WSTR:   sParseName := WideCharToString(mParseStruct.pOleStr);
               STRRET_OFFSET: sParseName := PChar(DWORD(mPIDL) + mParseStruct.uOffset);
             end;

             if UpperCase(sParseName) = UpperCase(mNextDir) then
                Break;
           end
      else
        begin
          mFolder := nil;
          Result  := nil;
          Exit;
        end;

      if iDidGet = 0 then
         begin
           mFolder := nil;
           Result  := nil;
           Exit;
         end;

      mPIDLBase := mPIDL;
      mFolder   := mSubFolder;

      if not FileExists(mNextDir) then
         OLECheck(mFolder.BindToObject(mPIDL, nil, IID_IShellFolder, Pointer(mSubFolder)));
    end;

  ShellFolder := mFolder;
  if ShellFolder = nil then
     Result := nil
  else
    Result := mPIDL;
end;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  mPopup: HMENU;
  mCmd: Integer;
  mCmdInfo: TCMInvokeCommandInfo;
  mPIDL: PItemIDList;
  mShellFolder: IShellFolder;
  S: String;
begin
  mPIDL := SHGetIDListFromPath(FileName, mShellFolder);
  if not Assigned(mPIDL) then
     Exit;

  OLECheck(mShellFolder.GetUIObjectOf(Handle, 1, mPIDL, IID_IContextMenu, nil,
    Pointer(mContextMenu)));

  mPopup := CreatePopUpMenu;
  if mPopup = 0 then
     Exit;
  try
    OLECheck(mContextMenu.QueryContextMenu(Form1.PopupMenu1.Handle {mPopup}, 0 {Index}, 1 {idCmdFirst}, 0 {_$7FFF}{idCmdLast}, CMF_NORMAL));
    OLECheck(mContextMenu.QueryInterface(IID_IContextMenu2, mContextMenu2));

    try
      mCmd := Integer(TrackPopupMenuEx(Form1.PopupMenu1.Handle {mPopup}, TPM_LEFTALIGN or
                TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL or TPM_RETURNCMD, X, Y, Handle, nil));

      // Hint anzeigen
      SetLength(S,40);
      mContextMenu.GetCommandString(mCmd,GCS_HELPTEXT,nil,PChar(S),SizeOf(S));
      Form1.StatusBar1.Panels[0].Text := S;

      // "OnClick" Ereignisse ausführen
      if mCmd <> 0 then
         case mCmd of
           1: Form1.A1.Click;
           2: Form1.B1.Click;
         else
           begin
             FillChar(mCmdInfo, SizeOf(mCmdInfo), 0);
             with mCmdInfo do
               begin
                 cbSize := SizeOf(TCMInvokeCommandInfo);
                 lpVerb := MakeIntResource(mCmd - 1);
                 nShow  := SW_SHOWNORMAL;
               end;
             try
               mContextMenu.InvokeCommand(mCmdInfo);
             except
               // nichts tun
             end;
           end;
         end;
    finally
      mContextMenu2 := nil;
    end;
  finally
    DestroyMenu(mPopup);
  end;
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_INITMENUPOPUP,
    WM_DRAWITEM,
    WM_MENUCHAR,
    WM_MEASUREITEM: begin
                      if Assigned(mContextMenu2) then
                         begin
                           If (mContextMenu2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam) <> NOERROR) then
                              inherited WndProc(Message)
                           else
                             Message.Result := 0;
                         end
                      else
                        inherited WndProc(Message);
                    end;
  else
    inherited WndProc(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  mContextMenu2 := nil;
end;

// Aufruf
procedure TForm1.Button1Click(Sender: TObject);
begin
  ContextMenuForFile('C:\Eigene Dateien\_Test\Test.txt',Mouse.CursorPos.x,Mouse.CursorPos.y,Handle);
end;

[franz]

Ich habe das erste Problem folgendermaßen gelöst:

Delphi-Quellcode:

function ExecMenuItemAction(Cmd: Integer; var Count: Integer; Item: TMenuItem): Boolean;
var
  ix: Integer;
begin
  Result := false;

  ix := 0;
  while ix < Item.Count do
    begin
      Application.ProcessMessages;

      if Cmd = Count then
         begin
           Item[ix].Click;
           Result := true;
           Exit;
         end;

      if Item.Items[ix].Count > 0 then
         ExecMenuItemAction(Cmd,Count,Item.Items[ix]);

      Inc(Count);
      Inc(ix);
    end;
end;

procedure ContextMenuForFile(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
  mPopup: HMENU;
  iCmd, iCount: Integer;
  mCmdInfo: TCMInvokeCommandInfo;
  mPIDL: PItemIDList;
  mShellFolder: IShellFolder;
  S: String;
begin
  mPIDL := SHGetIDListFromPath(FileName, mShellFolder);
  if not Assigned(mPIDL) then
     Exit;

  OLECheck(mShellFolder.GetUIObjectOf(Handle, 1, mPIDL, IID_IContextMenu, nil,
    Pointer(mContextMenu)));

  mPopup := CreatePopUpMenu;
  if mPopup = 0 then
     Exit;
  try
    OLECheck(mContextMenu.QueryContextMenu(Form1.PopupMenu1.Handle {mPopup}, 0 {Index}, 0 {idCmdFirst}, 0 {_$7FFF}{idCmdLast}, CMF_NORMAL));
    OLECheck(mContextMenu.QueryInterface(IID_IContextMenu2, mContextMenu2));

    try
      iCmd := Integer(TrackPopupMenuEx(Form1.PopupMenu1.Handle {mPopup}, TPM_LEFTALIGN or
                TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL or TPM_RETURNCMD, X, Y, Handle, nil));

      // Hint anzeigen
      SetLength(S,40);
      mContextMenu.GetCommandString(iCmd,GCS_HELPTEXT,nil,PChar(S),SizeOf(S));
      Form1.StatusBar1.Panels[0].Text := S;

      // "OnClick" Ereignisse ausführen
      if iCmd <> 0 then
         begin
           FillChar(mCmdInfo, SizeOf(mCmdInfo), 0);
           with mCmdInfo do
             begin
               cbSize := SizeOf(TCMInvokeCommandInfo);
               lpVerb := MakeIntResource(iCmd - 1);
               nShow  := SW_SHOWNORMAL;
             end;
           try
             if not Succeeded(mContextMenu.InvokeCommand(mCmdInfo)) then
                begin
                  iCount := 1;
                  ExecMenuItemAction(iCmd,iCount,Form1.PopupMenu1.Items);
                end;
           except
             // nichts tun
           end;
         end;
    finally
      mContextMenu  := nil;
      mContextMenu2 := nil;
    end;
  finally
    DestroyMenu(mPopup);
  end;
end;

Beleiben noch Probleme 2 – 5.

Ich wäre ja schon zufrieden, wenn sich eine Lösung für Problem 4 finden würde.

[franz]

Es funktioniert jetzt soweit.
Nur noch ein kleines Problem: Wenn die Maus über das „Senden an“ Menü geführt wird, klappt dieses mit allen Einträgen auf. Wenn der Benutzer allerdings mit der Tastatur den Menüeintrag ansteuert, enthält es wieder den Eintrag „Senden an“. Der Grund dafür ist, dass in der „WndProc“ folgendes steht:

Delphi-Quellcode:

WM_MENUSELECT:
  begin
    // Prüfen, ob das Owner Draw Shell Popup Menü (mPopupMenu2) gezeichnet werden kann
    iMenuPos := Integer(MenuItemFromPoint(Handle,HMENU Message.LParam),TPoint(Mouse.CursorPos)));
    if GetSubMenu(HMENU(Message.LParam),iMenuPos) > 0 then
       CanDraw := iMenuPos in [(iHandlerIndex)..(iHandlerIndex + iHandlerCount)];
    ValidCmdArea := CanDraw;
    inherited WndProc(Message);
  end;

:gruebel: Meine Frage: Wie kann ich den Index des ausgewählten Menüeintrags ermitteln ohne mit der Maus darüber zufahren?

Hinweis:
Es handelt sich um ein reines API Menü.

[franz]

Das eine Problem ist noch nicht gelöst. So lange keine eigenen Menüeinträge hinzugefügt werden oder das Menü mit der Maus bedient wird, funktioniert es zumindest mit Windows 98.

Ich habe folgendes geschrieben:

Delphi-Quellcode:

…
type
  TShellMenuKind = (smkOnlyHandler, smkComplete, smkDefaultOnly, smkNoDefault);

type
  TForm1 = class(TForm)
…
  public
    { Public-Deklarationen }
    procedure WndProc(var Message: TMessage); override;
…

implementation

uses
  ShellApi, ShlObj, ComObj, FileCtrl, ActiveX, CommCtrl;
{$R *.DFM}

var
  mContextMenu:  IContextMenu;
  mContextMenu2: IContextMenu2;
  iHandlerIndex, iHandlerCount: Integer;
  CanDraw, ValidCmdArea: Boolean;

function SHGetIDListFromPath(FileName: TFileName; var ShellFolder: IShellFolder): PItemIDList;
var
  sParseName: String;
  mTempPath, mNextDir: TFileName;
  iScanParam: Integer;
  iDidGet: Cardinal;
  mFolder, mSubFolder: IShellFolder;
  mPIDL, mPIDLbase: PItemIDList;
  mParseStruct: TStrRet;
  mEList: IEnumIDList;

  procedure GetDirs(var TempPath, NextDir: TFileName);
  var
    iSlashPos: Integer;

    function SlashDirName(ADir: String): String;
    var
      S: String;
      RootDir: Boolean;
    begin
      if ADir <> '' then
         begin
           S := ADir;
           RootDir := ((Length(S)=3) and (S[2]=':')) or (S='\');
           if not RootDir then
              if S[Length(S)] <> '\' then
                 S := S + '\';
           Result := S;
         end;
    end;
  begin
    iSlashPos := Pos('\', TempPath);
    if iSlashPos > 0 then
       begin
         if Pos(':', TempPath) > 0 then
            NextDir := Copy(TempPath, 1, 3)
         else
           NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, iSlashPos - 1);
         TempPath := Copy(TempPath, iSlashPos + 1, Length(TempPath));
       end
    else
      begin
        if NextDir = '' then
           NextDir := TempPath
        else
          NextDir := SlashDirName(NextDir) + TempPath;
        TempPath := '';
      end;
  end;
begin
  SHGetDesktopFolder(mFolder);
  SHGetSpecialFolderLocation(0, CSIDL_DRIVES, mPIDLbase);

  OLECheck(mFolder.BindToObject(mPIDLbase, nil, IID_IShellFolder, Pointer(mSubFolder)));
  mTempPath := FileName;
  mNextDir  := '';

  while Length(mTempPath) > 0 do
    begin
      GetDirs(mTempPath,mNextDir);

      mPIDL := mPidlBase;
      iScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
      if (mNextDir = FileName) and (not DirectoryExists(FileName)) then
         iScanParam := iScanParam or SHCONTF_NONFOLDERS;

      if S_OK = mSubFolder.EnumObjects(0, iScanParam, mEList) then
         while S_OK = mEList.Next(1, mPIDL, iDidGet) do
           begin
             OLECheck(mSubFolder.GetDisplayNameOf(mPIDL, SHGDN_FORPARSING, mParseStruct));
             case mParseStruct.uType of
               STRRET_CSTR:   sParseName := mParseStruct.cStr;
               STRRET_WSTR:   sParseName := WideCharToString(mParseStruct.pOleStr);
               STRRET_OFFSET: sParseName := PChar(DWORD(mPIDL) + mParseStruct.uOffset);
             end;

             if UpperCase(sParseName) = UpperCase(mNextDir) then
                Break;
           end
      else
        begin
          mFolder := nil;
          Result  := nil;
          Exit;
        end;

      if iDidGet = 0 then
         begin
           mFolder := nil;
           Result  := nil;
           Exit;
         end;

      mPIDLBase := mPIDL;
      mFolder   := mSubFolder;

      if not FileExists(mNextDir) then
         OLECheck(mFolder.BindToObject(mPIDL, nil, IID_IShellFolder, Pointer(mSubFolder)));
    end;

  ShellFolder := mFolder;
  if ShellFolder = nil then
     Result := nil
  else
    Result := mPIDL;
end;

procedure ContextMenuForFile(FileName: TFileName; HandlerIndex, X, Y: Integer;
            Handle: HWND; PopupMenu: TPopupMenu; MenuType: TShellMenuKind);
var
  mPopup: HMENU;
  iCmd, iID, iRes, iCmdLast: Integer;
  iFlags: Cardinal;
  mCmdInfo: TCMInvokeCommandInfo;
  mPIDL: PItemIDList;
  mShellFolder: IShellFolder;
  aMenuBitmaps: array of TBitmap;

  function ExecMenuItemAction(Cmd: Integer; var ID: Integer; Item: TMenuItem): Boolean;
  var
    ix: Integer;
  begin
    Result := false;

    ix := 0;
    while ix < Item.Count do
      begin
        Application.ProcessMessages;

        if Cmd = ID then
           begin
             Item[ix].Click;
             Result := true;
             Exit;
           end;

        if Item.Items[ix].Count > 0 then
           ExecMenuItemAction(Cmd,ID,Item.Items[ix]);

        Inc(ID);
        Inc(ix);
      end;
  end;

  function AddVCLMenuItems(APIMenu: HMENU; var ID: Integer;
    Item: TMenuItem; CanAddLine: Boolean; ArrayPos: Integer): Integer;
  var
    ix: Integer;
    SubMenu: HMenu;
    mBitmap: TBitmap;

    function GetItemFlags(Item: TMenuItem): Cardinal;
    begin
      Result := MF_STRING;
      if Item.Checked then
         Result := Result or MF_CHECKED;
      if not Item.Enabled then
         Result := Result or MF_GRAYED;
      if Item.Caption = cLineCaption then
         Result := Result or MF_SEPARATOR;
    end;

    procedure AddMenuBitmap(MnuID: Integer; MnuItm: TMenuItem);
    begin
      SetLength(aMenuBitmaps,ArrayPos + 1);
      aMenuBitmaps[ArrayPos] := TBitmap.Create;
      aMenuBitmaps[ArrayPos].Width  := 14;
      aMenuBitmaps[ArrayPos].Height := 14;

      if (Assigned(MnuItm.Bitmap)) and (not MnuItm.Bitmap.Empty) then
         begin
           aMenuBitmaps[ArrayPos].Canvas.StretchDraw(Rect(0,0,16,16),MnuItm.Bitmap);
           aMenuBitmaps[ArrayPos].TransparentColor := MnuItm.Bitmap.Canvas.Pixels[0,0];
           aMenuBitmaps[ArrayPos].Transparent := true;
         end
      else
        if (MnuItm.ImageIndex > -1) and (Assigned(PopupMenu.Images)) then
           begin
             mBitmap := TBitmap.Create;
             try
               PopupMenu.Images.GetBitmap(MnuItm.ImageIndex,mBitmap);
               aMenuBitmaps[ArrayPos].Canvas.StretchDraw(Rect(0,0,13,13),mBitmap);
             finally
               mBitmap.Free;
             end;
           end;

      SetMenuItemBitmaps(APIMenu,MnuID,MF_BYCOMMAND,aMenuBitmaps[ArrayPos].Handle,aMenuBitmaps[ArrayPos].Handle);
      Inc(ArrayPos);
    end;
  begin
    Result := 0;

    if CanAddLine then
       AppendMenu(APIMenu,MF_SEPARATOR,0,nil);

    ix := 0;
    while ix < Item.Count do
      begin
        Inc(Result);
        Application.ProcessMessages;

        if Item.Items[ix].Visible then
           begin
             // Item hinzufügen
             if Item.Items[ix].Count > 0 then
                begin // Untermenü erstellen, falls nötig
                  SubMenu := CreatePopupMenu;
                  Inc(Result,AddVCLMenuItems(SubMenu,ID,Item.Items[ix],false,ArrayPos));
                  AppendMenu(APIMenu,GetItemFlags(Item.Items[ix]) or MF_POPUP,SubMenu,PChar(Item.Items[ix].Caption));

                  // Check und RadioItem hinzufügen
                  if Item.Items[ix].Default then
                     SetMenuDefaultItem(APIMenu,ID,0);
                  if (Item.Items[ix].Checked) and (Item.Items[ix].RadioItem) then
                     CheckMenuRadioItem(APIMenu,ID,ID,ID,MF_BYCOMMAND);

                 // Bitmap hinzufügen
                 if ((Assigned(Item.Items[ix].Bitmap)) and (not Item.Items[ix].Bitmap.Empty)) or
                    ((Assigned(PopupMenu.Images))      and (Item.Items[ix].ImageIndex > -1))  and
                    (not Item.Items[ix].Checked) then
                    AddMenuBitmap(ID,Item.Items[ix]);

                  Inc(ID);
                end
             else
               begin // Menüeintrag hinzufügen
                 AppendMenu(APIMenu,GetItemFlags(Item.Items[ix]),ID,PChar(Item.Items[ix].Caption));

                 // Check und RadioItem hinzufügen
                 if Item.Items[ix].Default then
                    SetMenuDefaultItem(APIMenu,ID,0);
                 if (Item.Items[ix].Checked) and (Item.Items[ix].RadioItem) then
                    CheckMenuRadioItem(APIMenu,ID,ID,ID,MF_BYCOMMAND);

                 // Bitmap hinzufügen
                 if ((Assigned(Item.Items[ix].Bitmap)) and (not Item.Items[ix].Bitmap.Empty)) or
                    ((Assigned(PopupMenu.Images))      and (Item.Items[ix].ImageIndex > -1))  and
                    (not Item.Items[ix].Checked) then
                    AddMenuBitmap(ID,Item.Items[ix]);
               end;
           end;
        Inc(ID);
        Inc(ix);
      end;
  end;
begin
  mPIDL := SHGetIDListFromPath(FileName, mShellFolder);
  if not Assigned(mPIDL) then
     Exit;

  OLECheck(mShellFolder.GetUIObjectOf(Handle, 1, mPIDL, IID_IContextMenu, nil,
    Pointer(mContextMenu)));

  mPopup := CreatePopUpMenu;
  if mPopup = 0 then
     Exit;
  try
    // VCL Menüeinträge
    iID  := 1;
    iRes := AddVCLMenuItems(mPopup,iID,PopupMenu.Items,true,0);
    iHandlerCount := GetMenuItemCount(mPopup);

    // Einfügeposition korrigieren
    // Wichtig! Da sonst die "Senden an" Menüeinträge in das falsche
    //          Untermenü gezeichnet werden!
    if (HandlerIndex > PopupMenu.Items.Count) then
       HandlerIndex := PopupMenu.Items.Count;

    if (PopupMenu.Items.Count > 0) and (HandlerIndex < PopupMenu.Items.Count) then
       if PopupMenu.Items[HandlerIndex].Count > 0 then
          while (HandlerIndex < PopupMenu.Items.Count) and
                (PopupMenu.Items[HandlerIndex].Count > 0) do
                Inc(HandlerIndex);

    // Handler hinzufügen
    iCmdLast := 0;
    iFlags   := CMF_NORMAL;
    case MenuType of
      smkOnlyHandler: begin
                        iCmdLast := 0;
                        iFlags := CMF_NORMAL;
                      end;
      smkComplete:    begin
                        iCmdLast := $7FFF;
                        iFlags   := CMF_NORMAL;
                      end;
      smkDefaultOnly: begin
                        iCmdLast := $7FFF;
                        iFlags   := CMF_DEFAULTONLY;
                      end;
      smkNoDefault:   begin
                        iCmdLast := $7FFF;
                        iFlags   := CMF_NODEFAULT;
                      end;
    end;

    OLECheck(mContextMenu.QueryContextMenu(mPopup, HandlerIndex + 1, HandlerIndex + 1, iCmdLast, iFlags));
    OLECheck(mContextMenu.QueryInterface(IID_IContextMenu2, mContextMenu2));
    try
      iHandlerCount := GetMenuItemCount(mPopup) - iHandlerCount + 1;
      if PopupMenu.Items.Count > 0 then
         iHandlerIndex := HandlerIndex
      else
        iHandlerIndex := 0;

      iCmd := Integer(TrackPopupMenuEx(mPopup, TPM_LEFTALIGN or
                TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL or TPM_RETURNCMD, X, Y, Handle, nil));

      if not (iCmd in [0..iRes]) then
         Dec(iCmd,HandlerIndex);

      // "OnClick" Ereignisse ausführen
      if (MenuType <> smkOnlyHandler) and (iCmd = 1) and
         (PopupMenu.Items.Count > 0)  then
         PopupMenu.Items[0].Click
      else
        if iCmd <> 0 then
           begin
             if (ValidCmdArea)            or (MenuType = smkDefaultOnly) or
                (MenuType = smkNoDefault) or (PopupMenu.Items.Count = 0) then
                begin // OnClick des Shell Menus
                  FillChar(mCmdInfo, SizeOf(mCmdInfo), 0);
                  with mCmdInfo do
                    begin
                      cbSize := SizeOf(TCMInvokeCommandInfo);
                      lpVerb := MakeIntResource(iCmd - 1);
                      nShow  := SW_SHOWNORMAL;
                    end;
                  try
                    if not Succeeded(mContextMenu.InvokeCommand(mCmdInfo)) then
                       begin // Wenn die Ausführung fehlgeschlagen ist
                         iID := 1;
                         ExecMenuItemAction(iCmd,iID,PopupMenu.Items);
                       end;
                  except
                    // nichts tun
                  end;
                end
             else
               begin // VCL OnClick ausführen
                 iID := 1;
                 ExecMenuItemAction(iCmd,iID,PopupMenu.Items);
               end;
           end;
    finally
      mContextMenu  := nil;
      mContextMenu2 := nil;
    end;
  finally
    DestroyMenu(mPopup);
  end;
end;

// Wenn der Benutzer mit der rechten Maustaste klickt Menü anzeigen
procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  DestroyMenu((Sender as TPopupMenu).Handle);
  ContextMenuForFile('C:\Eigene Dateien\_Test\Test.txt',3,Mouse.CursorPos.x,
    Mouse.CursorPos.y,Handle,(Sender as TPopupMenu),smkComplete);
end;

procedure TForm1.WndProc(var Message: TMessage);
var
  iMenuPos: Integer;
begin
  case Message.Msg of
    WM_MENUSELECT:  begin
                      // Prüfen, ob das Owner Draw Shell Popup Menü (mPopupMenu2) gezeichnet werden kann
                      iMenuPos := Integer(MenuItemFromPoint(Handle,HMENU(Message.LParam),TPoint(Mouse.CursorPos)));
                      if GetSubMenu(HMENU(Message.LParam),iMenuPos) > 0 then
                         CanDraw := iMenuPos in [(iHandlerIndex)..(iHandlerIndex + iHandlerCount)];
                      ValidCmdArea := CanDraw;
                      inherited WndProc(Message);
                    end;
    WM_INITMENUPOPUP,
    WM_DRAWITEM,
    WM_MENUCHAR,
    WM_MEASUREITEM: begin
                      // Owner Draw Shell Popup Menü zeichnen
                      if (Assigned(mContextMenu2)) and (CanDraw) then
                         begin
                            If (mContextMenu2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam) <> NOERROR) then
                               inherited WndProc(Message)
                            else
                              Message.Result := 0;
                         end
                      else
                        inherited WndProc(Message);
                    end;
  else
    inherited WndProc(Message);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  mContextMenu2 := nil;
end;

Das Menü braucht nicht extra aufgerufen werden. Wenn der Benutzer die rechte Maustaste drückt wird das Menü angezeigt.

Allerdings muss folgende Ereignisbehandlungsroutine für „OnPopup“ (bei TPopupMenu) oder „OnBeforePopup“ (bei TFJFPopupMenu) geschrieben werden:

Delphi-Quellcode:

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  DestroyMenu((Sender as TPopupMenu).Handle);
  ContextMenuForFile('C:\Eigene Dateien\_Test\Test.txt',3,Mouse.CursorPos.x,
    Mouse.CursorPos.y,Handle,(Sender as TPopupMenu),smkOnlyHandler);
end;

Der letzte Parameter von „ContextMenuForFile“ gibt an, welcher Teil des Shell Menüs angezeigt werden soll.

Zugegeben es ist etwas viel geworden, aber wenigstens funktioniert es einigermaßen.

Der nächste Schritt ist die Erstellung einer Komponente. Allerdings muss die Komponente „WndProc“ von „TForm“ überschreiben, damit diese funktioniert. Ich habe schon einiges probiert. Mit „TApplication.OnMessage“ funktioniert es nicht und mit einem Hook stürzt Windows ab!

Vielleicht hat jemand eine Idee.

PS: Bitte lasst mich nicht wieder hängen. Auch wenn Ihr keine Lösung wisst bitte meldet euch, dann weiß ich wenigstens, dass dieses Thema von jemandem gelesen wird.

[Assarbad]

Gelesen, aber keine Idee.

[franz]

Ich habe jetzt das letzte Problem mit „GetMenuItemInfo“ gelöst und außerdem einige Änderungen vorgenommen. Jetzt funktioniert alles, zumindest mit Windows 98, soweit. Bleibt noch die Komponente.

Ich habe mal das gesamte Testprojekt beigefügt, bei deren Verwendung die Angabe der Dateipfade zu beachten ist.

[franz]

:hello: Damit die Komponente funktionierte, musste TApplication.HookMainWindow verwendet werden. Solange keine Untermenüs im eigenen Menü verwendet werden, funktioniert es.

Die restlichen kleineren Macken werde ich demnächst beheben.

Wer die Komponente haben will, kann Sie sich downloaden.

[franz]

Die bisherige Komponente hat leider noch einige schwere Fehler.
Hier habt Ihr eine verbesserte Version.

[Christian Seehase]

Moin Franz,

würdest Du bitte mal Deinen überlangen Beitrag auch in ein Attachement verwandeln.
Danke.

[quirks]

Genau das hab ich ewig gesucht! :thumb:

Hab aber noch etwas verbessert: Die Kompo hat immer überprüft, ob es die Datei gibt, deren Kontextmenü man zeigen will. Aber es gibt doch auch Verzeichnisse, auf die man das anwenden kann...
Also alle

Delphi-Quellcode:

(FileExists(FileName))

durch

Delphi-Quellcode:

((FileExists(FileName)) or (DirectoryExists(Filename)))

ersetzt. Jetzt kann man auch Kontextmenüs von Verzeichnissen anzeigen lassen.

Hab die veränderte Kompo-Datei mal angehängt.

[jonx]

hallo,
wirklich netten component...
aber kennten sie nicht de itemprop component?
oder hab ich etwas nicht verchtanden?

so, warum bin ich hier?
weil ich auch etwas versuche und bring es nicht hin.

was ich gerne tun mochte, ist den popup menu zu meinen eigenen menu so anhängen...
schaut euch bitte meinen Beispiel an...

can mir hiemanden bitte helfen?

Vielen dank.

John.

ps:mein deutsch ist nicht sehr gut weil ich französisch bin :mrgreen: