ListView и контекстное меню как в проводнике, как сделать?

← →
LAndrew (2002-09-15 22:07) [0]

Имеется ListView c Items, содержащими имена файлов, SubItems содержат пути к ним. Как сделать так, чтобы при нажатии на правую кнопку мышки появлялось то же самое меню, что и в проводнике? Что-то подобное есть в примере Virtual List Demo от Delphi 5, но разобраться я так и не смог как это все перенести на ListView.

← →
kex86 © (2002-09-16 01:52) [1]

Так тебе чё надо - PopupMenu или PopupMenu как в проводнике?

← →
LAndrew (2002-09-16 20:28) [2]

надо PopupMenu как в проводнике

← →
pusrg © (2002-09-16 20:33) [3]

Так в чем проблема?
Используй компонент TPopupMenu.
Создавай динамически итемы с любым содержимым.

← →
LAndrew (2002-09-16 21:27) [4]

Блин, всё не так просто. Вот если в проводнике или где-нибудь ещё в ВИнде кликнуть правой кнопкой мышки на файле или папке, то появляется менюшка, так вот мне нужна та же самая менюшка со всеми работающими пунктами, причем, чтобы самому не писать обработку всех команд. Надеюсь, теперь ясно, что я хочу.

← →
Ученик © (2002-09-16 21:55) [5]

На странице компонентов Samples есть TShellListView, он обладает всеми требуемые свойствами.

← →
LAndrew (2002-09-17 19:27) [6]

я в курсе о TShellListView, но он мне не подходит, т.к. 1) он дает возможность перемещения по папкам, а мне это не нужно 2) он отображает все файлы, а не только те, к-рые я вывожу в ListView 3) файлы я вывожу из разных папок (SubItems содержат пути к ним)
и вообще, мне нужно только точно такое же меню и всё. ТОлько вот как его сделать?

← →
Ученик © (2002-09-17 19:36) [7]

Не знаю, поможет ли, но исходники тут Delphi6\Demos\ShellControls

← →
Shrek © (2002-09-17 19:38) [8]

Я знаю что есть возможность визова диалогово окна подключения сетевого диска. Тоже самое и сменю. В проводнике используется тоже самое меню что и для диска С:. Если проводник может это делать и даже нортон командер под виндовс может это сделать то и простой смертный програмист это может. Удачи.

← →
alena.svt © (2002-09-17 19:49) [9]

LAndrew (17.09.02 19:27) он тебе не подходит. Так может ты хоть в его исходничек заглянешь и посмотришь как там BORLAND меню вызывает!

← →
Shrek © (2002-09-17 20:01) [10]

Разберайся.
http://www.napolifirewall.com/rundll32.htm

← →
Smok_er (2002-09-17 20:47) [11]

Шутник однако :)

← →
alena.svt © (2002-09-17 20:58) [12]

Smok_er (17.09.02 20:47)
Присоединяюсь.

LAndrew
Слушай ну получишь ты это меню с огромным трудом(так как ст. ф-й на это нет) но потом у тебя возникнет головная боль почему твое меню не копирует не переменовывает не открывает etc уж поверь так оно и будет.
Совет тебе зайди на AppControls.com скачай DiskControl платный но это сам понимаешь.
Там тебе и поик файлов и значки в листе и меню твое рабочее в демо все есть. Ну если хочешь можешь и заплатить за него он дешевый только на русской странице.
http://www.appcontrols.com/

← →
Набережных С. (2002-09-17 21:00) [13]

> Smok_er (17.09.02 20:47)

Написал, в-общем-то, от нечего делать, и почти не проверял. Поэтому возможны ошибки. Будут проблемы - пиши sergeynbr@newmail.ru
unit ContextMenu; interface uses windows, Messages, ComObj, ShlObj, ShellAPI, SysUtils; type TInvokeVerb = (ivVerbNone, ivVerbOpen, ivVerbRename, ivVerbDelete, ivVerbPaste, ivVerbProp, ivVerbOther, ivVerbError); { Root - Идентификатор родительской папки объекта. Для объекта файловой системы может быть CSIDL_DESKTOP(0). Для других объектов должен содержать соответствующий идентификатор, например CSIDL_CONTROLS или CSIDL_DRIVES. Список имеется в файле ShlObj.pas. OwnHandle - Handle окна-владельца. ОБЯЗАТЕЛЬНО должно быть указано! AName - Имя объекта. М.б. полным именем файла или именем виртуального объекта, например, "Мои документы". ClnLeft, ClnTop - Координаты меню в клиентской области окна-владельца. Примеры вызова: ###################################################################### InvokeContextMenu(CSIDL_DRIVES,Edit1.Handle,"Локальный диск (C:)",0,0); ###################################################################### var OldName,NewName:string; begin OldName:="D:/ReadMe.txt"; NewName:=OldName; if InvokeContextMenu(0,Edit1.Handle,OldName,0,0)))) = ivVerbRename then begin if InputQuery("Переименование файла","Введите новое имя:",NewName)then RenameFile(OldName,NewName); end; end; ###################################################################### var OldName,NewName:string; begin if SelectDirectory("","",OldName)then begin Application.ProcessMessages; OldName:=ExcludeTrailingBackslash(OldName); if InvokeContextMenu(CSIDL_DESKTOP,Handle,OldName,0,0) = ivVerbRename then if InputQuery("Переименование директории","Введите новое имя:",NewName)then RenameFile(OldName,NewName); end; end; ###################################################################### } function InvokeContextMenu(Root:Integer; OwnHandle:THandle; AName:TFileName; ClnLeft, ClnTop: Integer):TInvokeVerb;

← →
Набережных С. (2002-09-17 21:01) [14]

implementation var ICM2: IContextMenu2 = nil; function WndPrc(H:hwnd; Msg:UINT ; wP:WPARAM; lP:LPARAM):integer;stdcall; begin if ((Msg = WM_INITMENUPOPUP) or (Msg = WM_DRAWITEM) or (Msg = WM_MENUCHAR) or (Msg = WM_MEASUREITEM)) and Assigned(ICM2) then ICM2.HandleMenuMsg(Msg, wP, lP); Result:=DefWindowProc(H,Msg,wP,lP); end; var UtilWindowClass: TWndClass = ( style: 0; lpfnWndProc: @WndPrc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: "TSNShellInvokeWindow"); const SCmdVerbOpen = "open"; SCmdVerbRename = "rename"; SCmdVerbDelete = "delete"; SCmdVerbPaste = "paste"; SCmdVerbProp = "properties"; function AllocateHWnd: HWND; var TempClass: TWndClass; ClassRegistered: Boolean; begin UtilWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass); end; Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, "", WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); end; function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=""): string; {Функция скопирована из модуля ShellCtrls без изменений} var P: PChar; begin case StrRet.uType of STRRET_CSTR: SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); STRRET_OFFSET: begin P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); end; STRRET_WSTR: if Assigned(StrRet.pOleStr) then Result := StrRet.pOleStr else Result := ""; end; { This is a hack bug fix to get around Windows Shell Controls returning spurious "?"s in date/time detail fields } if (Length(Result) > 1) and (Result[1] = "?") and (Result[2] in ["0".."9"]) then Result := StringReplace(Result,"?","",[rfReplaceAll]); end; function FindObj(OwnHandle:THandle; Folder: IShellFolder; AName:string):PItemIDList; var Enum: IEnumIDList; HR: HResult; NumIDs: LongWord; StrRet: TStrRet; ID:PItemIDList; S:string; begin Result:=nil; try HR := Folder.EnumObjects(OwnHandle, 96, Enum); if HR <> 0 then Exit; except end; while Enum.Next(1, ID, NumIDs) = S_OK do begin FillChar(StrRet, SizeOf(StrRet), 0); Folder.GetDisplayNameOf(ID,1,StrRet); S:=StrRetToString(ID,StrRet); if AnsiSameText(S,AName) then begin Result:=ID; Break; end; end; end;

← →
Набережных С. (2002-09-17 21:01) [15]

function InvokeContextMenu(Root:Integer; OwnHandle:THandle; AName:TFileName; ClnLeft, ClnTop: Integer):TInvokeVerb; var PIDL,PFIDL,PSIDL: PItemIDList; CM: IContextMenu; Menu: HMenu; ICI: TCMInvokeCommandInfo; P: TPoint; Command: LongBool; ICmd: integer; ZVerb: array[0..255] of char; Verb: string; HR: HResult; SD,SF:IShellFolder; Num,Flg:cardinal; SavePath:string; szPath: array[0..MAX_PATH] of char; TmpWnd: THandle; begin Result:=ivVerbNone; if OwnHandle = 0 then Exit; if SHGetDesktopFolder(SD)<>S_OK then Exit; if Root<>CSIDL_DESKTOP then begin if SHGetSpecialFolderLocation(OwnHandle,Root,PSIDL)<>S_OK then Exit; if SD.BindToObject(PSIDL,nil,IShellFolder,SF)<>S_OK then Exit; SD:=SF; end; Num:=Length(ExtractFileDir(AName)); Flg:=0; SD.ParseDisplayName(OwnHandle,nil,StringToOLESTR(ExtractFileDir(AName)),Num,PFIDL,Flg); if PFIDL = nil then SF:=SD else if SD.BindToObject(PFIDL,nil,IShellFolder,SF)<>S_OK then Exit; Num:=Length(ExtractFileName(AName)); Flg:=0; if SF.ParseDisplayName(OwnHandle,nil,StringToOLESTR(ExtractFileName(AName)),Num,PIDL,Flg)<>S_OK then PIDL:=FindObj(OwnHandle,SF,AName); if PIDL = nil then Exit; if SF.GetUIObjectOf(OwnHandle, 1, PIDL, IID_IContextMenu, nil, CM)<>S_OK then Exit; if CM = nil then Exit; P.X := ClnLeft; P.Y := ClnTop; Windows.ClientToScreen(OwnHandle, P); Menu := CreatePopupMenu; try CM.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME); TmpWnd:=AllocateHWnd; try CM.QueryInterface(IID_IContextMenu2, ICM2); try Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, P.X, P.Y, 0, OwnHandle, nil); finally ICM2 := nil; end; finally if TmpWnd <> 0 then DestroyWindow(TmpWnd); end; if Command then begin ICmd := LongInt(Command) - 1; HR := CM.GetCommandString(ICmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb)); Verb := StrPas(ZVerb); if SameText(Verb, SCmdVerbRename) then begin Result:=ivVerbRename; Exit; end; if SameText(Verb, SCmdVerbOpen) then begin GetCurrentDirectory(MAX_PATH, szPath); SavePath := StrPas(szPath); StrPCopy(szPath, ExtractFilePath(AName)); SetCurrentDirectory(szPath); Result:=ivVerbOpen; end; try FillChar(ICI, SizeOf(ICI), #0); with ICI do begin cbSize := SizeOf(ICI); hWND := OwnHandle; lpVerb := MakeIntResource(ICmd); nShow := SW_SHOWNORMAL; end; HR := CM.InvokeCommand(ICI); if (HR<>S_OK) then Result:=ivVerbError else if Result = ivVerbNone then begin if SameText(Verb,SCmdVerbDelete)then Result:=ivVerbDelete else if SameText(Verb,SCmdVerbPaste)then Result:=ivVerbPaste else if SameText(Verb,SCmdVerbProp)then Result:=ivVerbProp else Result:=ivVerbOther; end; finally if (HR = S_OK) and SameText(Verb, SCmdVerbOpen) then SetCurrentDirectory(PChar(SavePath)); end; end; finally DestroyMenu(Menu); end; end; end.

Ну и выдернули вы ему исходник- зачем у него эти же коды на его компе есть, только их поискать надо было помучиться а потом вопросы кидать.

← →
Набережных С. (2002-09-17 21:23) [17]

Сейчас просмотрел посты и тут-же заметил ошибку:))
В функции AllocateHWND забыл подправить, нужно вместо фрагмента
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass);
вставить:
if not ClassRegistered then Windows.RegisterClass(UtilWindowClass);

← →
Набережных С. (2002-09-17 21:37) [18]

> alena.svt © (17.09.02 21:14)

Если человек имеет способности к программированию, то пример реализации ему иногда может дать больше, чем сотни советов(IMHO).
У меня-же этот исходник лежит уже месяца 3 и неизвестно когда понадобится - жалко потраченного времени, хоть кому-то пригодится:) К тому-же над ним еще и поработать нужно.
А вообще-то практически на любой вопрос на форуме можно дать ответ:"смотри исходники","смотри хелп","читай книги". Вы не согласны? Так, может, сделать "штамп" и отмечать все поступающие вопросы автоматически? Как идея?:))

2 Набережных С. (17.09.02 21:37)
Я конечно согласна что надо помогать и я если вы за мной хоть когда нибудь наблюдали отвечаю практически на все вопросы с приведенными кодами(Конечно если ответ есть). И даже не единожды про как поместить иконку в трэй разжовывала с нуля хотя по этому вопросу уж давно пора наверное просто выкидывать с ветки.
И вы думаете что он что-то поймет в том что вы ему написали, я сомневаюсь.
И если чего есть намного короче способы и есть они в кладовках факах и т.д. Просто я считаю что надо биться башкой об косяк пока не доходит а вот когда действительно лоб онемеет только тогда и прыгать сюда с вопросами.(Переносно конечно и IMXO)

Да я чего не дописала человек не может с VirtualListView из демок разобраться а тут...........
Извините только не посчитайте грубостью.

← →
Набережных С. (2002-09-18 16:52) [21]

> alena.svt ©

Милая девушка!
Приношу глубочайшие извинения!!
Я вовсе не имел в виду в чем-то Вас упрекнуть или обидеть! Если это выглядело так, то мне искренне жаль. Всему виной мои косноязычие и дурной характер - конечно, это меня не оправдывает.
И Вам совершенно незачем и не в чем оправдываться, честное слово! Я всего лишь пытался объяснить, почему выложил этот код, и, как видно, у меня это совсем не получилось:)

> человек не может с VirtualListView из демок разобраться

Но бывает же так, по себе знаю: по отдельности вроде все понятно, а в единое целое не увязывается, не хватает какой-то детали или внешнего толчка(или пинка:)). Вдруг и здесь такой случай, ведь возможно?
P.S. Если Вы меня простили, то не могли бы подсказать ссылку на более простое решение задачи(интересует принцип). Мне в голову как-то не приходит и в сети не встречал, а вдруг понадобится. Да и для общего развития совсем нелишне:)

> LAndrew

Еще один "рудимент" от экспериментов: в строке

Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
TPM_RETURNCMD, P.X, P.Y, 0, OwnHandle, nil);
забыл исправить OwnHandle на TmpWnd. В общем, будь внимателен, если станешь разбираться.

ListView и контекстное меню как в проводнике, как сделать? Найти похожие ветки