Вот я сделал свой MediaPlayer1. В нем есть несколько недочетов:
изменение громкости - при начале воспроизведения громкость все равно 100 %, хотя шкала показывает 50%. Все стает нормально, если подвигать этот ползунок. Как это исправить? Второе: при открытии файла, имя его записывается в
ListBox1, во-первых: при двойном клике файл открывается, проигрывается, при открытии нового файла, все-равно остается прошлый файл в ListBox1. При повторном открытии происходит непонятное с TrackBar1(полоса прогресса музыки) и 2(Изменение громкости). Эта непонятность станет вам видна, при тестировании exe ниже приложенного. А во-вторых: как можно реализовать удаление объекта из ListBox1 кнопкой del? Третье: при проигрывании Mp3
остаток времени показывает правильно, при проигрывании wav - пишет огромное кол. минут. Как это исправить. Вроде все, если найдете в exe еще ошибки при тестировании, прошу так же исправить. Вот код, касающийся только проигрывания:
Код:
Const
MCI_SETAUDIO = $0873;
MCI_DGV_SETAUDIO_VOLUME = $4002;
MCI_DGV_SETAUDIO_ITEM = $00800000;
MCI_DGV_SETAUDIO_VALUE = $01000000;
MCI_DGV_STATUS_VOLUME = $4019;
type
MCI_DGV_SETAUDIO_PARMS = record
dwCallback: DWORD;
dwItem: DWORD;
dwValue: DWORD;
dwOver: DWORD;
lpstrAlgorithm: PChar;
lpstrQuality: PChar;
end;
type
MCI_STATUS_PARMS = record
dwCallback: DWORD;
dwReturn: DWORD;
dwItem: DWORD;
dwTrack: DWORD;
end;
procedure SetMPVolume(MP: TMediaPlayer; Volume: Integer);
{ Volume: 0 - 1000 }
var
p: MCI_DGV_SETAUDIO_PARMS;
begin
{ Volume: 0 - 1000 }
p.dwCallback := 0;
p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
p.dwValue := Volume;
p.dwOver := 0;
p.lpstrAlgorithm := nil;
p.lpstrQuality := nil;
mciSendCommand(MP.DeviceID, MCI_SETAUDIO,
MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));
end;
function GetMPVolume(MP: TMediaPlayer): Integer;
var
p: MCI_STATUS_PARMS;
begin
p.dwCallback := 0;
p.dwItem := MCI_DGV_STATUS_VOLUME;
mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p));
Result := p.dwReturn;
{ Volume: 0 - 1000 }
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MediaPlayer1.Shareable:=False;
MediaPlayer1.AutoRewind:=True;
MediaPlayer1.Wait:=True;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
OpenDialog1.Options:=[ofAllowMultiSelect];
MediaPlayer1.FileName:=' ';
With OpenDialog1 do
Begin
If not Execute then Exit;
MediaPlayer1.FileName:=FileName;
MediaPlayer1.Open;
TrackBar1.Max:=MediaPlayer1.Length;
TrackBar1.Min:=MediaPlayer1.StartPos;
Timer1.Enabled:=True;
if ListBox1.Count>0 then
begin
mediaplayer1.FileName:=listbox1.Items.Strings[listbox1.itemindex];
mediaplayer1.Open;
TrackBar2.Max:=mediaplayer1.Length;
Timer1.Enabled:=true;
//***устанавливаем начальную громкость
SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);
mediaplayer1.Play;
end
else {ShowMessage('Playlist is empty'); }
begin
ListBox1.Clear;
listbox1.Items.AddStrings(opendialog1.Files);
//***автоматически выделяем первый файл в списке
ListBox1.Selected[0]:=true;
//***автоматически воспроизводим выделенный
if CheckBox1.Checked then MediaPlayer1.Play;
end;
end;
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
Mediaplayer1.FileName:=listbox1.items.Strings[listbox1.itemindex];//добавляем строки
mediaplayer1.Open; //открываем
TrackBar1.Max:=mediaplayer1.Length;// приравниваеммаксимальную длину прогрессбара к текущей длине трэка
Timer1.Enabled:=true; //запускаем таймер для отсчёта времени
//***устанавливаем начальную громкость
SetMPVolume(MediaPlayer1, 1000-TrackBar1.Position*50);
mediaplayer1.Play; //воспроизводим
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
With SaveDialog3 do
Begin
If not Execute then Exit;
MediaPlayer1.FileName:=FileName;
MediaPlayer1.Save;
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
MediaPlayer1.Close;
TrackBar2.Max:=TrackBar2.Min;
Application.Terminate;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
Var
Len,Pos,MinLeft,SecLeft,Min,Sec: Integer;
begin
if TrackBar1.Max<>0 then
begin
TrackBar1.Position:=MediaPlayer1.Position;
Len:=Mediaplayer1.TrackLength[ListBox1.ItemIndex];
//***вычесление времени
Pos := Mediaplayer1.Position;
MinLeft := ((Len - Pos) div 1000) div 60;//осталось мин
SecLeft := ((Len - Pos) div 1000) mod 60;//осталось сек
Min := (Pos div 1000) div 60;
Sec := (Pos div 1000) mod 60;
//***осталось
if SecLeft < 10 then
label9.Caption := '0' + IntToStr(SecLeft)
else
label9.Caption := IntToStr(SecLeft);
if MinLeft < 10 then
label8.Caption := '0' + IntToStr(MinLeft)+':'
else
label8.Caption := IntToStr(MinLeft)+':';
//***прошло
if Sec < 10 then
label7.Caption := '0' + IntToStr(Sec)
else
label7.Caption := IntToStr(Sec);
if Min < 10 then
label6.Caption := '0' + IntToStr(Min)+':'
else
label6.Caption := IntToStr(Min)+':';
end;
end;
//***изменение громкости
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
SetMPVolume(MediaPlayer1, 1000-TrackBar2.Position*50);
Label5.Caption:=IntToStr(100-TrackBar2.Position*5)+'%';
end;
//***навигация по треку
procedure TForm1.TrackBar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pos:integer;
begin
pos:=round((100 / TrackBar1.Width)*x);//***позиция клика
MediaPlayer1.Position:=(MediaPlayer1.Length div 100)*pos;
MediaPlayer1.Play;
end;
procedure TForm1.Button10Click(Sender: TObject);
var
chosenDir:string;
f: tSearchRec;
begin
//***вместо '' можно указать путь по умолчанию, напр. 'c:\music\'
//***если оставить '' то будет предложен стандартный диалог выбора каталога
if SelectDirectory('Выберите каталог','', chosenDir)
then
begin
ListBox1.Clear;
if (FindFirst(chosenDir+'\*.mp3', faAnyFile, f)=0) or
(FindFirst(chosenDir+'\*.wma', faAnyFile, f)=0) or
(FindFirst(chosenDir+'\*.wav', faAnyFile, f)=0)
then
repeat
ListBox1.Items.Add(chosenDir+'\'+f.Name);
FindNext(f);
ListBox1.Items.Add(chosenDir+'\'+f.Name);
until FindNext(f)<>0;
if ListBox1.Items.Count<>0 then
begin
//***автоматически выделяем первый файл в списке
ListBox1.Selected[0]:=true;
//***автоматически воспроизводим выделенный
if (CheckBox1.Checked) then MediaPlayer1.Play;
end;
end;
end;
Буду благодарен за помощь! Отнеситесь с пониманием и протестируйте программу. Примеры wav прилагаю, mp3 возьмите свои.