Пятница, 29.03.2024, 11:02
Приветствую Вас Гость

Не ошибается тот, кто ничего не делает.
Но и ничего не делать - ошибка.

Эмиль Кроткий

Меню сайта
Категории раздела
Delphi [12]
Материалы, связанные с программирование на Delphi
Форма входа

Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0


















Тиц
Главная » 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;

Пример ее подключения есть в исходниках к статье.

Скачать исходник к статье можно здесь.


Категория: Delphi | Просмотров: 9357 | Добавил: xaramamburu | Теги: плейлист, перетаскивание файлов, Drag&Drop | Рейтинг: 4.2/4
Всего комментариев: 29
27 Турист  
0
Здравствуйте. Спасибо за уроки, пытаюсь создать плеер на основании ваших двух уроках. Все вроде бы не чего НО при добавлении Драг&Дроп при компиляции на выходе получаются две ошибки:
[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.

28 xaramamburu  
0
Что у вас перед разделом Type делает описание процедуры:
procedure TForm_player.ListBox1Click(Sender: TObject); 
begin
Отсюда скорее всего и ошибка.)))

29 Турист  
0
Спасибо! Исправлю и исправлюсь)

4 MuLtLaNdIa  
0
Доброго времени суток! Очень хороший сайт! По вашему уроку сделал очень хороший плеер, но вот одна проблема с Drag&Drop. Прописал все процедуры, подключил LISTBOX к ним, а когда скомпилировал программу и перетакиваю МР3 файлы, то курсор меняется, но файлы не добавляются. Пробовал отдельно программу сделать, всё работает, а здесь нет.
Уже всю голову сломал... Не знаю почему...
Исходник могу скинуть на почту.

5 xaramamburu  
1
Скидывайте посмотрю.

6 MuLtLaNdIa  
0
Скинул))) Очень надеюсь на Вашу помощь! Заранне спасибо.

7 xaramamburu  
1
Исправьте
DragAcceptFiles(FoRm_PLaYeR_1.ListBox1.Handle, True);
на
DragAcceptFiles(FoRm_PLaYeR_1.Handle, True);

Не знаю почему, но ListBox1 отказывается принимать файлы если его расположить на панели. Поэтому либо уберите ListBox1 с панели или сделайте как показано выше. Пока ничего другого предложить не могу.))))

8 MuLtLaNdIa  
0
Понятно)) Большое спасибо)) Сейчас попробую)) smile

9 MuLtLaNdIa  
0
Сделал как Вы и сказали smile Всё работает, только вот если кидать просто файлы, а вот если кидать целую папку, то опять таже проблема sad пробовал убрать с панели, та же история.
При компилировании ещё выдаёт такую ошибку:
[Warning] Mp3_1.pas(166): Variable 'FileName' might not have been initialized
Может это что-то даст... smile

10 xaramamburu  
0
Ну не знаю, у меня все работает. В том проекте, что вы мне скинули procedure GetAllFiles( Path: string); прописана, но не прописан вызов ее из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles);.
Скидываю мой вариант вам на почту, правда там отключен модуль basswma... Проверяйте. smile Да забыл сказать, что после загрузки песен в плейлист нужно добавить выбор песни в плейлисте. Смотрите комментарии 71-72 к уроку 1.4 по mp3 плееру.))))

11 MuLtLaNdIa  
0
Большое Вам спасибо smile Всё работает. Теперь я к Вам часто буду на форуме писать smile Вопросов ещё много по поводу плеера smile Спасибо.

14 BM_GORA  
0
В общем проблема такова, при переносе папки курсор мыши меняется но файлы из папки не переносятся ( как прописать вызов procedure GetAllFiles( Path: string); из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles);. ?

12 BM_GORA  
0
добавил procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles); но при запуске выдает Expected '=' 'but' '(' found. в чем проблема ?

13 BM_GORA  
0
или я чет не догоняю, чтобы прописать вызов из procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles); нужно procedure TFoRm_PLaYeR_1.WMDropFiles(var Msg: TWMDropFiles); всавить в type ? или нужен еще какой то код ?

15 BM_GORA  
0
а вот кстатии и сам код, так, если нужно )

implementation
{$R *.dfm}

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;

16 xaramamburu  
0
Смотрите исходник к статье он полностью рабочий и комментарий 75, 76, 95 к уроку 1.4 по созданию mp3 плеера.))))

17 BM_GORA  
0
теперь же когда я перетаскиваю папку с музыкой в плей лист то выходит ошибка '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;

25 Praying  
0
Такая же проблема, было бы интересно, узнать, в чем же причина=)

26 xaramamburu  
0
Я уже сейчас не помню, что я отвечал BM_GORA, надо смотреть ваш проект. Скидывайте мне на почту, будет время посмотрю. Адрес почты ниже в комментариях.)))

18 BM_GORA  
0
if listbox1.Count<>0 then i1:=ListBox1.ItemIndex else i:=0;

убрал вот эту еденичку, но все равно ошибка осталась

19 xaramamburu  
0
Я еще раз вам говорю смотрите исходник к этой статье drag_drop2, там показано как подключить функцию GetAllFiles( Path: string); к процедуре WMDropFiles(var Msg: TWMDropFiles); smile

20 BM_GORA  
0
да в том то и дело, смотрел и не один раз, все тоже самое что и в исходниках, нет конешно может быть такое что я чето упустил, но я уже не раз проверял

21 BM_GORA  
0
хотя ща еще раз перепроверю

22 BM_GORA  
0
вот, переделал все заного, теперь все закидывается в плей лист, но при нажатии на плей вылазиет вот это :
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)
Причем если открывать просто через опен файлз то все равно такая же ошибка

23 xaramamburu  
0
Это ошибка доступа к памяти, т.к. у вас она выскакивает и через опен файл, то скорее всего она ни как не связана с процедурами перетаскивания файлов. Нужно смотреть весь код. Если есть желание можете скинуть его мне на почту xaramamburu@list.ru , будет время посмотрю. smile

24 BM_GORA  
0
ок, скинул, жду ответа ))))

1 Иван  
0
Ругается на SelAPI в uses...
File not found: 'sellapi.dcu'

2 xaramamburu  
0
Судя по вашей ошибке, у вас не правильно прописано название модуля ShellAPI в uses.)))

3 Filo$oF  
0
И в правду. Что-то я не доглядел smile

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Календарь
«  Февраль 2012  »
ПнВтСрЧтПтСбВс
  12345
6789101112
13141516171819
20212223242526
272829
Архив записей
Поиск
Наш опрос
Оцените мой сайт
Всего ответов: 585
Уголок общения



Copyright MyCorp © 2024Конструктор сайтов - uCoz