ContextMenuHandlers in eigene PopupMenüs einbinden

[franz]

Bin jetzt etwas weiter.

Allerdings gibt es immer noch 5 Probleme.

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?


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.



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.



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.


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;