Главная » 2012 » Февраль » 12 » Перетаскивание имен файлов из проводника в ListBox с помощью мыши (Drag&Drop).
19:16
Перетаскивание имен файлов из проводника в ListBox с помощью мыши (Drag&Drop).
Перетаскивание имен файлов из проводника в ListBox с помощью мыши (Drag&Drop)
Очень часто в таких программах, как аудио и видео плееры необходимо сделать загрузку плейлиста, путем перетаскивания файлов прямо из проводника. Такая технология называется Drag-and-drop (в переводе с английского означает буквально тащи-и-бросай; Бери-и-Брось). В сегодняшней статье я покажу как это можно сделать в Delphi, на примере загрузки mp3 файлов в ListBox из проводника, путем перетаскивания их мышкой. Для этого в начале познакомимся с функцией DragQueryFile. Функция за декларирована в модуле ShellApi.
Данная функция извлекает имена перемещенных мышью файлов. Ниже приведено описание функции:
DragQueryFile ( hDrop: Integer , // дескриптор структуры для перемещенных файлов iFile: Cardinal , // индекс запрошенного файла lpszFile:PWideChar , // буфер для имени файла cch:Cardinal // размер буфера для имени файла ): Cardinal;
Параметры: hDrop - идентифицирует структуру, содержащую имена файлов. iFile - определяет индекс запрашиваемого файла. Если значение параметра iFile равно 0xFFFFFFFF , DragQueryFile возвращает число перемещенных файлов. Если значение параметра iFile лежит между нулем и количеством перемещенных файлов, DragQueryFile копирует соответствующее значению им файла в буфер, указанный параметром lpszFile . lpszFile - указывает на буфер для имени перемещенного файла. Им файла представляет собой завершающуюся нулем строку. Если значение lpszFile равно NULL , DragQueryFile возвращает необходимый размер буфера в символах. cch - определяет размер буфера в символах.
Приступим к созданию нашего проекта. Запускаем Delphi и создаем новое приложение. На форме размещаем компонент TListBox из вкладки Standard.
Затем переходим к написанию кода.
В разделе Uses добавим модуль ShellAPI.
В разделе private добавим следующий код:
//получение сообщений о переносе файла в окно приложения procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
В разделе implementation добавим описание данной процедуры:
//процедура извлечения имен файлов при перетаскивании procedure TForm1.WMDropFiles(var Msg: TWMDropFiles); var i: integer;//счетчик файлов CountFile: integer;//Количество файлов size: integer;//длина строки, содержащей путь к файлу Filename: PChar; //указатель на имя файла begin try //Функция DragQueryFile извлекает имена перемещенных мышью файлов //получаем количество перемещаемых файлов CountFile := DragQueryFile(Msg.Drop, $FFFFFFFF, Filename, 255); //извлекаем пути до перемещаемых файлов и добавляем их в ListBox for i := 0 to (CountFile - 1) do begin //получаем длину строки, содержащей путь к файлу size := DragQueryFile(Msg.Drop, i , nil, 0)+1; //выделяем память под строку с именем файла Filename:= StrAlloc(size); //получаем непосредственно само имя файла и путь DragQueryFile(Msg.Drop,i , Filename, size); //добавляем его в ListBox если расширение файла = '.mp3' //функция lowercase понижает регистр символов if lowercase(ExtractFileExt(StrPas(filename)))='.mp3' then listbox1.items.add(StrPas(Filename)); //освобождаем строку StrDispose(Filename); end; finally DragFinish(Msg.Drop); // отпуститим файл end; end;
Ну и в событии OnCreate формы добавим код, говорящий нашему ListBox, что он должен принимать файлы.
procedure TForm1.FormCreate(Sender: TObject); begin //регистрируем, что окно ListBox1 будет принимать файлы DragAcceptFiles(Form1.ListBox1.Handle, True); //Внимание если ListBox располагается на панели то для регистрации пишем //DragAcceptFiles(Form1.Handle, True); end;
Сохраняем и тестируем проект.
А если к нашему проекту добавить следующую процедуру, которая выложена на просторах Интернета, то можно и целые папки перетаскивать в ListBox.
//процедура, позволяющая добавить список mp3 файлов из любой папки в ListBox1 //в процедуру при вызове необходимо передать путь к папке с файлами procedure GetAllFiles( Path: string); var sRec: TSearchRec; isFound: boolean; begin isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0; while isFound do begin if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then begin if ( sRec.Attr and faDirectory ) = faDirectory then GetAllFiles( Path + '\' + sRec.Name); //условие, проверки, что файл является mp3 файлом, если эту строчку убрать, будут добавляться все файлы if lowercase(ExtractFileExt(Path + '\' + sRec.Name))='.mp3' then ListBox1.Items.Add( Path + '\' + sRec.Name ); end; Application.ProcessMessages; isFound := FindNext( sRec ) = 0; end; FindClose( sRec ); end;
Здравствуйте. Спасибо за уроки, пытаюсь создать плеер на основании ваших двух уроках. Все вроде бы не чего НО при добавлении Драг&Дроп при компиляции на выходе получаются две ошибки: [dcc32 Error] AudioPlayer.pas(473): E2029 Statement expected but 'TYPE' found и [dcc32 Error] AudioPlayer.pas(473): E2029 Statement expected but 'TYPE' found
Уже голову "сломал" в чем причина - помогите разобраться. Спасибо
p.s. весь код:
Код
procedure TForm_player.ListBox1Click(Sender: TObject); begin type TForm1 = class(TForm) ListBox1: TListBox; procedure FormCreate(Sender: TObject); procedure GetAllFiles( Path: string); private { Private declarations } //получение сообщений о переносе файла в окно приложения procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; public { Public declarations } end;
var Form1: TForm1; procedure TForm1.FormCreate(Sender: TObject); begin //регистрируем, что окно ListBox1 будет принимать файлы DragAcceptFiles(Form1.ListBox1.Handle, True); end;
//процедура извлечения имен файлов при перетаскивании procedure TForm1.WMDropFiles(var Msg: TWMDropFiles); var i: integer;//счетчик файлов CountFile: integer;//Количество файлов size: integer;//длина строки, содержащей путь к файлу Filename: PChar; //указатель на имя файла begin try //Функция DragQueryFile извлекает имена перемещенных мышью файлов //получаем количество перемещаемых файлов CountFile := DragQueryFile(Msg.Drop, $FFFFFFFF, Filename, 255); //извлекаем пути до перемещаемых файлов и добавляем их в ListBox for i := 0 to (CountFile - 1) do begin //получаем длину строки, содержащей путь к файлу size := DragQueryFile(Msg.Drop, i , nil, 0)+1; //выделяем память под строку с именем файла Filename:= StrAlloc(size); //получаем непосредственно само имя файла и путь DragQueryFile(Msg.Drop,i , Filename, size); //добавляем его в ListBox если расширение файла = '.mp3' //функция lowercase понижает регистр символов if DirectoryExists(StrPas(filename))=true then begin GetAllFiles(StrPas(filename)); end else if lowercase(ExtractFileExt(StrPas(filename)))='.mp3' then listbox1.items.add(StrPas(Filename)); //освобождаем строку StrDispose(Filename); end; finally DragFinish(Msg.Drop); // отпустить файл end; end;
procedure TForm1.GetAllFiles( Path: string); var sRec: TSearchRec; isFound: boolean; begin isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0; while isFound do begin if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then begin if ( sRec.Attr and faDirectory ) = faDirectory then GetAllFiles( Path + '\' + sRec.Name); if lowercase(ExtractFileExt(Path + '\' + sRec.Name))='.mp3' then ListBox1.Items.Add( Path + '\' + sRec.Name ); end; Application.ProcessMessages; isFound := FindNext( sRec ) = 0; end; FindClose( sRec ); end;
procedure TForm_player.ListBox1DblClick(Sender: TObject); begin i:=ListBox1.Itemindex; Filename:=ListBox1.Items.Strings[i]; mode:=stop; player; end; end.
Доброго времени суток! Очень хороший сайт! По вашему уроку сделал очень хороший плеер, но вот одна проблема с Drag&Drop. Прописал все процедуры, подключил LISTBOX к ним, а когда скомпилировал программу и перетакиваю МР3 файлы, то курсор меняется, но файлы не добавляются. Пробовал отдельно программу сделать, всё работает, а здесь нет. Уже всю голову сломал... Не знаю почему... Исходник могу скинуть на почту.
Исправьте DragAcceptFiles(FoRm_PLaYeR_1.ListBox1.Handle, True); на DragAcceptFiles(FoRm_PLaYeR_1.Handle, True);
Не знаю почему, но ListBox1 отказывается принимать файлы если его расположить на панели. Поэтому либо уберите ListBox1 с панели или сделайте как показано выше. Пока ничего другого предложить не могу.))))
Сделал как Вы и сказали Всё работает, только вот если кидать просто файлы, а вот если кидать целую папку, то опять таже проблема пробовал убрать с панели, та же история. При компилировании ещё выдаёт такую ошибку: [Warning] Mp3_1.pas(166): Variable 'FileName' might not have been initialized Может это что-то даст...
Ну не знаю, у меня все работает. В том проекте, что вы мне скинули procedure GetAllFiles( Path: string); прописана, но не прописан вызов ее из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles);. Скидываю мой вариант вам на почту, правда там отключен модуль basswma... Проверяйте. Да забыл сказать, что после загрузки песен в плейлист нужно добавить выбор песни в плейлисте. Смотрите комментарии 71-72 к уроку 1.4 по mp3 плееру.))))
В общем проблема такова, при переносе папки курсор мыши меняется но файлы из папки не переносятся ( как прописать вызов procedure GetAllFiles( Path: string); из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles);. ?
или я чет не догоняю, чтобы прописать вызов из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles); нужно procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles); всавить в type ? или нужен еще какой то код ?
теперь же когда я перетаскиваю папку с музыкой в плей лист то выходит ошибка 'List index out of bounds (1)'
вот код :
//процедура извлечения имен файлов при перетаскивании procedure TForm_player.WMDropFiles(var Msg: TWMDropFiles); var i1: integer;//счетчик файлов CountFile: integer;//Количество файлов size: integer;//длина строки, содержащей путь к файлу Filename1: PChar; //указатель на имя файла begin //проверяем если PlayList не пустой то запоминаем номер текущей песни //иначе устанавливаем номер песни 0 (первая позиция в PlayList) if listbox1.Count<>0 then i1:=ListBox1.ItemIndex else i:=0; try //Функция DragQueryFile извлекает имена перемещенных мышью файлов //получаем количество перемещаемых файлов CountFile := DragQueryFile(Msg.Drop, $FFFFFFFF, Filename1, 255); //извлекаем пути до перемещаемых файлов и добавляем их в ListBox for i1 := 0 to (CountFile - 1) do begin //получаем длину строки, содержащей путь к файлу size := DragQueryFile(Msg.Drop, i1 , nil, 0)+1; //выделяем память под строку с именем файла Filename1:= StrAlloc(size); //получаем непосредственно само имя файла и путь DragQueryFile(Msg.Drop,i1 , Filename1, size); //добавляем его в ListBox если расширение файла = '.mp3' //функция lowercase понижает регистр символов if lowercase(ExtractFileExt(StrPas(filename1)))='.mp3' then listbox1.items.add(StrPas(Filename1)); //освобождаем строку StrDispose(Filename1); end; finally DragFinish(Msg.Drop); // отпуститим файл //запоминаем имя файла текущей песни в плейлисте Filename:=ListBox1.Items.Strings[i]; //Выделяем эту песню в PlayList ListBox1.ItemIndex:=i; end; end; procedure TForm_player.GetAllFiles( Path: string); var sRec: TSearchRec; isFound: boolean; begin isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0; while isFound do begin if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then begin if ( sRec.Attr and faDirectory ) = faDirectory then GetAllFiles( Path + '\' + sRec.Name); if lowercase(ExtractFileExt(Path + '\' + sRec.Name))='.mp3' then ListBox1.Items.Add( Path + '\' + sRec.Name ); end; Application.ProcessMessages; isFound := FindNext( sRec ) = 0; end; FindClose( sRec ); end;
Я уже сейчас не помню, что я отвечал BM_GORA, надо смотреть ваш проект. Скидывайте мне на почту, будет время посмотрю. Адрес почты ниже в комментариях.)))
Я еще раз вам говорю смотрите исходник к этой статье drag_drop2, там показано как подключить функцию GetAllFiles( Path: string); к процедуре WMDropFiles(var Msg: TWMDropFiles);
да в том то и дело, смотрел и не один раз, все тоже самое что и в исходниках, нет конешно может быть такое что я чето упустил, но я уже не раз проверял
вот, переделал все заного, теперь все закидывается в плей лист, но при нажатии на плей вылазиет вот это : First chance exception at $759D9617. Exception class EAccessViolation with message 'Access violation at address 00484044 in module 'GorPlayer.exe'. Read of address 000003A8'. Process GorPlayer.exe (4556) Причем если открывать просто через опен файлз то все равно такая же ошибка
Это ошибка доступа к памяти, т.к. у вас она выскакивает и через опен файл, то скорее всего она ни как не связана с процедурами перетаскивания файлов. Нужно смотреть весь код. Если есть желание можете скинуть его мне на почту xaramamburu@list.ru , будет время посмотрю.