Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
2.627 Beiträge
 
Delphi 10.3 Rio
 
#5

AW: windows eigenschaften-dialog für datenträger anzeigen lassen

  Alt 23. Jun 2020, 07:36
Guten Morgen/Tag/Abend, hier jetzt mein Code-Problem wie oben beschrieben:

Delphi-Quellcode:
// hier ist mein problem-kind
procedure TMain.InvokeContextMenu(const Owner: TWinControl; const Path: String;
  const X, Y: Integer);
var
  // Item: Integer;
  DeskFolder, Folder: IShellFolder;
  Eaten, Attributes: ULONG;
  PIDL, FolderpIdl: PItemIDList;
  Menu: HMENU;
  Pos: TPoint;
  Cmd: DWORD;
  CommandInfo: TCMInvokeCommandInfo;
  ContextMenu: IContextMenu;
  ContextMenu2: IContextMenu2;
  ContextMenu3: IContextMenu3;
  APath: String;
  aFileName: String;
  aDrive: String;
  aContextMenu: Boolean;
begin
  ContextMenu2 := nil;
  ContextMenu3 := nil;
  aContextMenu := False;

  aDrive := ExtractFileDrive(Path);

  APath := ExtractFilePath(Path);
  if (APath = aDrive) then
    APath := IncludeTrailingPathDelimiter(APath);

  aFileName := ExtractFileName(Path);

  // IShellFolder for Desktop folder (root)
  if Succeeded(SHGetDesktopFolder(DeskFolder)) then
  begin
    // Item ID List for the folder that the file or folder is in
    Attributes := 0;
    if Succeeded(DeskFolder.ParseDisplayName(INVALID_HANDLE_VALUE, nil,
      PWideChar(WideString(APath)), Eaten, FolderpIdl, Attributes)) then
    begin
      // IShellFolder for the folder the file is in
      Attributes := 0;
      if Succeeded(DeskFolder.BindToObject(FolderpIdl, nil, IShellFolder,
        Folder)) then
        if (Length(aFileName) > 0) then
          // Item ID List for the file or folder, relative to the folder it is in
          if Succeeded(Folder.ParseDisplayName(INVALID_HANDLE_VALUE, nil,
            PWideChar(WideString(aFileName)), Eaten, PIDL, Attributes)) then
          begin
            // connect IContextMenu with local PIDL ContextMenu
            aContextMenu := Succeeded(Folder.GetUIObjectOf(INVALID_HANDLE_VALUE,
              1, PIDL, IContextMenu, nil, ContextMenu));
            CoTaskMemFree(PIDL);
          end;
      // try to fallback to system context menu
     // an dieser stelle hüpft der code wenn man "Eigenschaften" von Laufwerken auswählt.
      if (not aContextMenu) then
        // connect IContextMenu with local FolderPIDL ContextMenu
        aContextMenu := Succeeded(DeskFolder.GetUIObjectOf(INVALID_HANDLE_VALUE,
          1, FolderpIdl, IContextMenu, nil, ContextMenu));
      CoTaskMemFree(FolderpIdl);
    end;
  end;

  if (not aContextMenu) then
    Exit;

  Menu := CreatePopupMenu;
  try
    // Populate our menu with shortcut items
    if (Cardinal(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE))
      and $80000000) = 0 then
    begin
      // ContextMenu2 used in WndProc
      if (ContextMenu.QueryInterface(IContextMenu2, ContextMenu2) = NO_ERROR) or
        (ContextMenu.QueryInterface(IContextMenu3, ContextMenu3) = NO_ERROR)
      then
        try
          Pos.X := X;
          Pos.Y := Y;
          Winapi.Windows.ClientToScreen(Owner.Handle, Pos);
          // launch the menu
          Bool(Cmd) := TrackPopupMenu(Menu, TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
            TPM_RETURNCMD, Pos.X, Pos.Y, 0, Handle, nil);
        finally
          // clear so that we don't intervene every owner drawn menu item message in
          // WndProc
          ContextMenu2 := nil;
          ContextMenu3 := nil;
        end;

      // Invoke command if we have one
      if Bool(Cmd) then
      begin
        FillChar(CommandInfo, SizeOf(CommandInfo), 0);
        CommandInfo.cbSize := SizeOf(CommandInfo);
        CommandInfo.HWnd := Handle;
        CommandInfo.lpVerb := PAnsiChar(MakeIntResource(Cmd - 1));
        CommandInfo.fMask := CMIC_MASK_ICON or CMIC_MASK_UNICODE or
          CMIC_MASK_ASYNCOK or CMIC_MASK_NOZONECHECKS;
        CommandInfo.nShow := SW_SHOWNORMAL;
        OleCheck(ContextMenu.InvokeCommand(CommandInfo));
      end;
    end;

  finally
    DestroyMenu(Menu);
  end;
end;

// das menu wird hiermit eingeleitet.
// es wird immer der komplette pfad übermittelt.
// für laufwerke wird der slash abgeschnitten.
procedure TMain.LeftViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  S: String;
begin
  if Button = mbRight then
    if LeftView.Selected <> nil then
    begin
      S := LeftShellItem(LeftView.Selected.Index).FullPath;
      if S[Length(S)] = '\then
        S := Copy(S, 1, Length(S) - 1);
      InvokeContextMenu(Self, S, X, Y);
    end;
end;
Im Beispiel Anhang ist unten ein "F9" Knopf drückbar (nicht per Hotkey) der auf meine erste Post verweist, da hatte ich mich geirrt, verzeihung nochmal.
Zur Vollständigkeit hier der "F9" Knopf:

Delphi-Quellcode:
// der "F9" Knopf-Code, funktioniert 1A

procedure TMain.BTN_F09Click(Sender: TObject);
begin
  if LeftView.Selected <> nil then
    ShellExec(LeftShellItem(LeftView.Selected.Index).FullPath, 'properties');
end;

function ShellExec(const PIDL: PItemIDList; const Operation: string)
  : Boolean; overload;
var
  SEI: TShellExecuteInfo;
  Path: array [0 .. 512] of WideChar;
begin
  Result := False;
  if SHGetPathFromIDList(PIDL, @Path) then
  begin
    FillChar(SEI, SizeOf(SEI), 0);
    SEI.Wnd := GetActiveWindow();
    SEI.cbSize := SizeOf(SEI);
    SEI.lpFile := PChar(@Path);
    SEI.lpVerb := PChar(Operation);
    SEI.fMask := SEE_MASK_INVOKEIDLIST;
    SEI.nShow := SW_SHOWNORMAL;
    Result := ShellExecuteEx(@SEI);
  end;
end;
Danke für's Lesen!


Der Anhang ist nur ein Kompilat, ohne Quelltext, da noch mörderisch in Entwicklung.
Benutzt wird Delphi Rio.
Angehängte Dateien
Dateityp: 7z Invoke.7z (878,2 KB, 4x aufgerufen)
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat