(Resolvido) Lista de musicas

António44 · Janeiro 29, 2017

Meus amigos preciso de ajuda no seguinte.

Com o codigo que já estou usando como faço um play na lista,para iniçiar na faixa 1 ate ao final da lista.

procedure TForm1.Button5Click(Sender: TObject);
begin
if listbox1.itemindex <0 then
showmessage('lista vazia...selecione musica ')else
begin
  mciSendString('Close MM', abc, 0, 0); //Close audio
 fname := listbox1.Items.strings[listbox1.itemindex]; //Get what was selected
 abc3 := GetShortName(fname); //Change filename to short file name
 abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
 mciSendString(abc2, abc, 0, 0); //Open the file to play
 mciSendString('Play MM', abc, 0, 0); //Play the file
end;
end;

Alguma ideia ai, é que assim só reproduz uma a uma ou seja,a seleccionada e não reproduz a lista toda mesmo que seleccione todas as faixas da lista.

Obrigada

**Jhonas** · Janeiro 30, 2017

não tenho esse componente que voce esta usando, mas se voce consegue reproduzir a musica selecionada, então bastaria voce colocar esse código dentro de um FOR

tocaria da musica selecionada até o final da lista

exemplo .... não sei se vai funcionar pois não tenho esse componente, mas pela lógica deveria

procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
   if listbox1.itemindex <0 then
      showmessage('lista vazia...selecione musica ')else
      begin
         For i := listbox1.itemindex to listbox1.Count do
            begin
               mciSendString('Close MM', abc, 0, 0); //Close audio
               fname := listbox1.Items.strings[i]; //Get what was selected
               abc3 := GetShortName(fname); //Change filename to short file name
               abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
               mciSendString(abc2, abc, 0, 0); //Open the file to play
               mciSendString('Play MM', abc, 0, 0); //Play the file
            end;
      end;

end;

OBS: voce tem que colocar uma condição para ir somente para o proximo item da lista se a musica atual chegar ao final

abraço

António44 · Janeiro 30, 2017

17 minutos atrás, Jhonas disse:

var i : integer; begin if listbox1.itemindex <0 then showmessage('lista vazia...selecione musica ')else begin For i := listbox1.itemindex to listbox1.Count do begin mciSendString('Close MM', abc, 0, 0); //Close audio fname := listbox1.Items.strings; //Get what was selected abc3 := GetShortName(fname); //Change filename to short file name abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code mciSendString(abc2, abc, 0, 0); //Open the file to play mciSendString('Play MM', abc, 0, 0); //Play the file end; end; end;

Da erro na

listbox1.Count do

**Jhonas** · Janeiro 30, 2017

qual o erro ?

António44 · Janeiro 30, 2017

Eu não uso componte, aqui vai o codigo.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,MMSystem, Forms, Dialogs,
  StdCtrls, MPlayer, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    SaveDialog1: TSaveDialog;
    Button8: TButton;
    Button9: TButton;
    TrackBar1: TTrackBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
  
 procedure TestaVolume;
   procedure MudaVolume;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   fname : string; //FileName
  abc: pchar;     //Yes I know, wierd variables...but oh well!
  abc2: pchar;    // "  "  "  ,   "       "    ... "   "   "
  abc3: string;
  Cont : Integer = 0 ;
implementation
function GetShortName(sLongName : string) : string;
var
  sShortName    : string;
  nShortNameLen : integer;
begin
  SetLength( sShortName, MAX_PATH );
  nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
  if(0 = nShortNameLen)then
  begin
  end;
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;
function FSI(N: String): pchar;
var
  S : pchar;
begin
  S := PChar(N);
  FSI := S;
end;
{$R *.DFM}
procedure TForm1.MudaVolume;
 var
  WaveCaps : TWaveOutCaps;
  VolDir, VolEsq : Word;
begin
 
  VolEsq := Trunc((TrackBar1.Position-100) / 100 * $FFFF);
  VolDir := Trunc((TrackBar1.Position-100) / 100 * $FFFF);
  
  if waveOutGetDevCaps(WAVE_MAPPER, @WaveCaps, sizeof(TWaveOutCaps)) = MMSYSERR_NOERROR then
   if (WaveCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then
     WaveOutSetVolume(Integer(WAVE_MAPPER), MakeLong(VolEsq,VolDir));

end;
procedure TForm1.TestaVolume;
 var
  WaveCaps : TWaveOutCaps;
  Volume : DWord;
begin
 
  if waveOutGetDevCaps(WAVE_MAPPER, @WaveCaps, sizeof(TWaveOutCaps)) = MMSYSERR_NOERROR then
  if (WaveCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then begin

  WaveOutGetVolume(Integer(WAVE_MAPPER), @Volume);

  with TrackBar1 do
   Position := 100 - Trunc(LoWord(Volume) / $FFFF * 100);
  end;
    end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 If opendialog1.Execute = True Then  //Shows open dialog
 begin
   fname := opendialog1.filename; //Makes fname the filename selected (If one was selected)
   listbox1.items.add(opendialog1.filename); //Add it to the list box
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  OpenDialog1.Filter := '|All Files|*.*'; //Change open dialog to list files
  If OpenDialog1.Execute=True Then
  begin
    ListBox1.Items.LoadFromFile(OpenDialog1.Filename); //Open list
  end;
  OpenDialog1.Filter := 'Audio Files|*.mp3;*.wav;*.wma'; //Change open dialog to audio files
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  nRet : Longint;
  nNewWidth : Integer;
begin
  nNewWidth := ListBox1.Width + 300; //Set list box's horizontal bar length
  nRet := SendMessage(ListBox1.Handle, 1045, nNewWidth, 0); //Make list box have a horizontal bar!
 TestaVolume;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 mciSendString('Pause MM', abc, 0, 0); //Simple enough, pause!
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 mciSendString('Stop MM', abc, 0, 0); //Stop audio
 mciSendString('Close MM', abc, 0, 0); //Close audio for application
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if listbox1.itemindex <0 then
showmessage('lista vazia...selecione musica ')else
begin
  mciSendString('Close MM', abc, 0, 0); //Close audio
 fname := listbox1.Items.strings[listbox1.itemindex]; //Get what was selected
 abc3 := GetShortName(fname); //Change filename to short file name
 abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
 mciSendString(abc2, abc, 0, 0); //Open the file to play
 mciSendString('Play MM', abc, 0, 0); //Play the file
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
 mciSendString('Resume MM', abc, 0, 0); //Simple enough, pause!
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  SaveDialog1.Filter := 'List Files|*.lst|Txt Files|*.txt|All Files|*.*'; //Change filter to save
  If SaveDialog1.Execute=True Then
  begin
    ListBox1.Items.SaveToFile(SaveDialog1.Filename); //Save list to wherever selected
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var i : integer;
begin
   if listbox1.itemindex <0 then
      showmessage('lista vazia...selecione musica ')else
      begin
         For i := listbox1.itemindex to listbox1.Count do
            begin
               mciSendString('Close MM', abc, 0, 0); //Close audio
               fname := listbox1.Items.strings[listbox1.itemindex]; //Get what was selected
               abc3 := GetShortName(fname); //Change filename to short file name
               abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
               mciSendString(abc2, abc, 0, 0); //Open the file to play
               mciSendString('Play MM', abc, 0, 0); //Play the file
            end;
      end;

end;

procedure TForm1.Button9Click(Sender: TObject);
var  i : integer;
begin
 for i:=0 to ListBox1.Items.Count-1 do
ShowMessage( ListBox1.Items.Strings[i] );

end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
MudaVolume ;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  nRet : Longint;
  nNewWidth : Integer;
begin
  nNewWidth := ListBox1.Width + 300; //Set list box's horizontal bar length
  nRet := SendMessage(ListBox1.Handle, 1045, nNewWidth, 0); //Make list box have a horizontal bar!
 TestaVolume;
end;

end.

**Jhonas** · Janeiro 30, 2017

ok ... estou criando o form com os botões .... me passa o titulo dos botões

António44 · Janeiro 30, 2017

Tem o texto a frente da função....onde estou encravado é no

procedure TForm1.Button8Click(Sender: TObject);

de resto esta bom.

Obrigado

**Jhonas** · Janeiro 30, 2017

ok .... vou ver onde deve ser feita a mudança

**Jhonas** · Janeiro 30, 2017

Seu código está corrigido .... coloque um compontente TTimer para contar o tempo da musica, para poder ir para a proxima

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,MMSystem, Forms, Dialogs,
  StdCtrls, MPlayer, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    ListBox1: TListBox;
    TrackBar1: TTrackBar;
    Button9: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    mp3time: TTimer;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private

 procedure TestaVolume;
   procedure MudaVolume;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  fname : string; //FileName
  abc: pchar;     //Yes I know, wierd variables...but oh well!
  abc2: pchar;    // "  "  "  ,   "       "    ... "   "   "
  abc3: string;
  Cont : Integer = 0 ;

implementation

function GetShortName(sLongName : string) : string;
var
  sShortName    : string;
  nShortNameLen : integer;
begin
  SetLength( sShortName, MAX_PATH );
  nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
  if(0 = nShortNameLen)then
  begin
  end;
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;

function FSI(N: String): pchar;
var
  S : pchar;
begin
  S := PChar(N);
  FSI := S;
end;
{$R *.DFM}

procedure TForm1.MudaVolume;
 var
  WaveCaps : TWaveOutCaps;
  VolDir, VolEsq : Word;
begin
 
  VolEsq := Trunc((TrackBar1.Position-100) / 100 * $FFFF);
  VolDir := Trunc((TrackBar1.Position-100) / 100 * $FFFF);
  
  if waveOutGetDevCaps(WAVE_MAPPER, @WaveCaps, sizeof(TWaveOutCaps)) = MMSYSERR_NOERROR then
  if (WaveCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then
     WaveOutSetVolume(Integer(WAVE_MAPPER), MakeLong(VolEsq,VolDir));

end;

procedure TForm1.TestaVolume;
 var
  WaveCaps : TWaveOutCaps;
  Volume : DWord;
begin
 
  if waveOutGetDevCaps(WAVE_MAPPER, @WaveCaps, sizeof(TWaveOutCaps)) = MMSYSERR_NOERROR then
  if (WaveCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then begin

  WaveOutGetVolume(Integer(WAVE_MAPPER), @Volume);

  with TrackBar1 do
   Position := 100 - Trunc(LoWord(Volume) / $FFFF * 100);
  end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 If opendialog1.Execute = True Then  //Shows open dialog
 begin
   fname := opendialog1.filename; //Makes fname the filename selected (If one was selected)
   listbox1.items.add(opendialog1.filename); //Add it to the list box
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  OpenDialog1.Filter := '|All Files|*.*'; //Change open dialog to list files
  If OpenDialog1.Execute=True Then
  begin
    ListBox1.Items.LoadFromFile(OpenDialog1.Filename); //Open list
  end;
  OpenDialog1.Filter := 'Audio Files|*.mp3;*.wav;*.wma'; //Change open dialog to audio files
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  nRet : Longint;
  nNewWidth : Integer;
begin
  nNewWidth := ListBox1.Width + 300; //Set list box's horizontal bar length
  nRet := SendMessage(ListBox1.Handle, 1045, nNewWidth, 0); //Make list box have a horizontal bar!
  TestaVolume;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 mciSendString('Pause MM', abc, 0, 0); //Simple enough, pause!
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 mciSendString('Stop MM', abc, 0, 0); //Stop audio
 mciSendString('Close MM', abc, 0, 0); //Close audio for application
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if listbox1.itemindex <0 then
   showmessage('lista vazia...selecione musica ')else
   begin
     mciSendString('Close MM', abc, 0, 0); //Close audio
     fname := listbox1.Items.strings[listbox1.itemindex]; //Get what was selected
     abc3 := GetShortName(fname); //Change filename to short file name
     abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
     mciSendString(abc2, abc, 0, 0); //Open the file to play
     mciSendString('Play MM', abc, 0, 0); //Play the file
   end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  mciSendString('Resume MM', abc, 0, 0); //Simple enough, pause!
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  SaveDialog1.Filter := 'List Files|*.lst|Txt Files|*.txt|All Files|*.*'; //Change filter to save
  If SaveDialog1.Execute=True Then
  begin
    ListBox1.Items.SaveToFile(SaveDialog1.Filename); //Save list to wherever selected
  end;
end;

function lengthmp3(mp3path: string):integer;
var nlength: string;
begin
  mciSendString(PChar('open "' + mp3path + '" alias MP3'), NIL, 0, 0);
  setlength(nlength, 255);
  mciSendString('status MP3 length', pchar(nlength), length(nlength), 0);
  result:= StrToInt(nlength);
end;

procedure TForm1.Button8Click(Sender: TObject);
var i : integer;
begin

   if listbox1.itemindex <0 then
      showmessage('lista vazia...selecione musica ')else
      begin
         for i:= 0 to listbox1.items.count - 1 do  //// ALTERAÇÃO
         begin
            mp3time.Interval := lengthmp3(listbox1.items[i]);

            mciSendString('Close MM', abc, 0, 0); //Close audio
            fname := listbox1.Items.strings[i]; //Get what was selected
            abc3 := GetShortName(fname); //Change filename to short file name
            abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
            mciSendString(abc2, abc, 0, 0); //Open the file to play
            mciSendString('Play MM', abc, 0, 0); //Play the file
            sleep(mp3time.Interval); //// ESPERAR O TEMPO DA MUSICA
            mciSendString('Close MM', abc, 0, 0); //Close audio;
         end;
      end;

end;

procedure TForm1.Button9Click(Sender: TObject);
var  i : integer;
begin
  for i:=0 to ListBox1.Items.Count-1 do
     ShowMessage( ListBox1.Items.Strings[i] );

end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  MudaVolume ;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  nRet : Longint;
  nNewWidth : Integer;
begin
  nNewWidth := ListBox1.Width + 300; //Set list box's horizontal bar length
  nRet := SendMessage(ListBox1.Handle, 1045, nNewWidth, 0); //Make list box have a horizontal bar!
  TestaVolume;
end;


end.

veja a Function de contagem do tempo da musica e a alteração no botão 8 ( executar )

abraço

António44 · Janeiro 30, 2017

Da erro aqui..... mp3time.Interval := lengthmp3(listbox1.items);

procedure TForm1.Button8Click(Sender: TObject);
var i : integer;
begin
   if listbox1.itemindex <0 then
      showmessage('lista vazia...selecione musica ')else
      begin
         for i:= 0 to listbox1.items.count - 1 do  //// ALTERAÇÃO
         begin
            mp3time.Interval := lengthmp3(listbox1.items[i]);

            mciSendString('Close MM', abc, 0, 0); //Close audio
            fname := listbox1.Items.strings[i]; //Get what was selected
            abc3 := GetShortName(fname); //Change filename to short file name
            abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
            mciSendString(abc2, abc, 0, 0); //Open the file to play
            mciSendString('Play MM', abc, 0, 0); //Play the file
            sleep(mp3time.Interval); //// ESPERAR O TEMPO DA MUSICA
            mciSendString('Close MM', abc, 0, 0); //Close audio;
         end;
      end;

end;

**Jhonas** · Janeiro 30, 2017

voce colocou o componente Timer ? e colocou o nome de

mp3time

abraço

António44 · Janeiro 30, 2017

Esta tudo a funcionar muito obrigado jhonas...estou a testar agora uma lista de musicas.

Obrigado

abraço

**Jhonas** · Janeiro 30, 2017

OBS: voce vai notar que ao tocar a musica, devido ao código voce não vai poder clicar em outro botão, enquanto as musicas não chegarem ao final da lista.

nesse caso voce deve usar processmessages para poder liberar os outros botões

https://www.google.com.br/webhp?sourceid=chrome-instant&ion=1&espv=2&ie=UTF-8#q=processmessages+delphi

abraço

António44 · Janeiro 30, 2017

Agora eu testei aqui e reparei que o formulário trava a musica fica tocando mas não tenho como parar!

**Jhonas** · Janeiro 30, 2017

a solução no post anterior

abraço

António44 · Janeiro 30, 2017

Não costumo usar isso....como usaria.

procedure TForm1.Button8Click(Sender: TObject);
var i : integer;
begin
   if listbox1.itemindex <0 then
      showmessage('lista vazia...selecione musica ')else
      begin
         for i:= 0 to listbox1.items.count - 1 do  //// ALTERAÇÃO
         begin
            time.Interval := lengthmp3(listbox1.items[i]);

            mciSendString('Close MM', abc, 0, 0); //Close audio
            fname := listbox1.Items.strings[i]; //Get what was selected
            abc3 := GetShortName(fname); //Change filename to short file name
            abc2 := PChar('Open ' + abc3 + ' Alias MM'); //Open file code
            mciSendString(abc2, abc, 0, 0); //Open the file to play
            mciSendString('Play MM', abc, 0, 0); //Play the file
            sleep(time.Interval); //// ESPERAR O TEMPO DA MUSICA
            mciSendString('Close MM', abc, 0, 0); //Close audio;
         end;
      end;

end;

**Jhonas** · Janeiro 30, 2017

voce teria que usar o comando

Application.ProcessMessages;

mas para ele funcionar corretamente, ele teria que ser inserido no contador da musica, coisa que voce não tem nesse código.

abraço

António44 · Janeiro 30, 2017

E haverá uma forma de fazer isso ?

**Jhonas** · Janeiro 30, 2017

com o componente MediaPlayer seria muito mais facil fazer isso

mas se quiser tentar descobrir como montar uma função MCI que indique a posição da musica, tente esse link

http://www.delphipraxis.net/1175900-post30.html

ou veja esse projeto pronto usando MCI

https://www.codeproject.com/Articles/63094/Simple-MCI-Player

OBS: precisa se cadastrar ( colocar apenas o email ) para poder fazer o download do código

abraço

**Jhonas** · Janeiro 30, 2017

rotinas que podem te ajudar

procedure OpenMP3(FileName: String);
begin
  mciSendString(PChar('open "' + FileName + '" alias mp wait'), nil, 0, 0);
end;

procedure PlayMP3;
begin
  mciSendString(PChar('play mp'), nil, 0, 0);
end;

procedure StopMP3;
begin
  mciSendString(PChar('stop mp'), nil, 0, 0);
end;

procedure PauseMP3;
begin
  mciSendString(PChar('pause mp'), nil, 0, 0);
end;

procedure CloseMP3;
begin
  mciSendString(PChar('close mp'), nil, 0, 0);
end;

procedure ForwardMP3(ToPlace: LongInt = 1);
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) + ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

procedure RewindMP3(ToPlace: LongInt = 1);
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) - ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

function GetMP3Len: LongInt;
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp length wait'), TmpStr, 128, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  Result := StrToInt(TmpStr);
  FreeMem(TmpStr);
end;

function GetMP3Pos: LongInt;
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  Result := StrToInt(TmpStr);
  FreeMem(TmpStr);
end;

procedure SetMP3Pos(ToPlace: LongInt = 1);
begin
  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('play mp from ' + IntToStr(ToPlace)), nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);
end;

abraço

António44 · Janeiro 30, 2017

Não dou com a forma de contornar isto...

Abraço

Não dou com a forma de contornar isto...

Abraço

**Jhonas** · Janeiro 30, 2017

ok... estou modifcando o seu código para o código do post anterior

vou criar um contador para a musica

depois voce modifica a seu gosto ... aguarde

**Jhonas** · Janeiro 30, 2017

modifiquei todo o código ... agora esta funcionando como deveria ( toca as musicas da lista, não trava os botões, e tem um contador da musica para saber a posição final da musica )

o seu controle de som, eu retirei pois não estava funcionando... depois voce verifica isso

faça as demais modificações para o seu uso ... o resto agora é com voce ... ok ?

unit UPMP3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,MMSystem, Forms, Dialogs,
  StdCtrls, MPlayer, ComCtrls, ExtCtrls, Gauges;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    ListBox1: TListBox;
    TrackBar1: TTrackBar;
    Button9: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    Gauge1: TGauge;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  fname : string; //FileName
  i : integer = 0;

implementation


{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 If opendialog1.Execute = True Then  //Shows open dialog
 begin
   fname := opendialog1.filename; //Makes fname the filename selected (If one was selected)
   listbox1.items.add(opendialog1.filename); //Add it to the list box
 end;
end;

procedure OpenMP3(FileName: String);
begin
  mciSendString(PChar('open "' + FileName + '" alias mp wait'), nil, 0, 0);
end;

procedure PlayMP3;
begin
  mciSendString(PChar('play mp'), nil, 0, 0);
end;

procedure StopMP3;
begin
  mciSendString(PChar('stop mp'), nil, 0, 0);
end;

procedure PauseMP3;
begin
  mciSendString(PChar('pause mp'), nil, 0, 0);
end;

procedure CloseMP3;
begin
  mciSendString(PChar('close mp'), nil, 0, 0);
end;

procedure ForwardMP3(ToPlace: LongInt = 1);
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) + ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

procedure RewindMP3(ToPlace: LongInt = 1);
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) - ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

function GetMP3Len: LongInt;
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp length wait'), TmpStr, 128, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  Result := StrToInt(TmpStr);
  FreeMem(TmpStr);
end;

function GetMP3Pos: LongInt;
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  Result := StrToInt(TmpStr);
  FreeMem(TmpStr);
end;

procedure SetMP3Pos(ToPlace: LongInt = 1);
begin
  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('play mp from ' + IntToStr(ToPlace)), nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
   OpenMP3(fname);
end;

function lengthmp3(mp3path: string):integer;
var nlength: string;
begin
  mciSendString(PChar('open "' + mp3path + '" alias MP3'), NIL, 0, 0);
  setlength(nlength, 255);
  mciSendString('status MP3 length', pchar(nlength), length(nlength), 0);
  result:= StrToInt(nlength);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
   OpenMP3(fname);
   Gauge1.MaxValue := lengthmp3(fname);
   PlayMP3;
   Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

   Gauge1.Refresh;

  if Gauge1.MaxValue <> 0 then
     Gauge1.Progress := GetMP3Pos;

  if  Gauge1.Progress = Gauge1.MaxValue then
      begin
         Gauge1.Progress := 0;
         CloseMP3;
         fname :=  ListBox1.Items.Strings[listbox1.itemindex+1];
         OpenMP3(fname);
         PlayMP3;
      end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   StopMP3;
   Timer1.Enabled := false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   PauseMP3;
   Timer1.Enabled := false;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   RewindMP3;
   Gauge1.Progress := 0;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
   ForwardMP3;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
   StopMP3;
   CloseMP3;
   fname :=  ListBox1.Items.Strings[listbox1.itemindex];
   Gauge1.Progress := 0;
   Timer1.Enabled := false;
end;

end.

abaço

António44 · Janeiro 30, 2017

Tem erro

procedure ForwardMP3(ToPlace: LongInt =1);

=

procedure ForwardMP3(ToPlace: LongInt =1);//Erro aqui
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) + ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

procedure RewindMP3(ToPlace: LongInt = 1);//e aqui tb de dar
var
  TmpStr: PChar;
begin
  GetMem(TmpStr, 128);

  mciSendString(PChar('set mp time format milliSeconds'), nil, 0, 0);
  mciSendString(PChar('status mp position wait'), TmpStr, 128, 0);
  mciSendString(PChar('play mp from ' + IntToStr(StrToInt(TmpStr) - ToPlace)),
nil, 0, 0);
  mciSendString(PChar('set mp time format tmsf'), nil, 0, 0);

  FreeMem(TmpStr);
end;

**Jhonas** · Janeiro 30, 2017

o meu esta funcionando corretamente

veja se voce não esqueceu de declarar alguma uses .. principalmente a MMSystem

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,MMSystem, Forms, Dialogs,
  StdCtrls, MPlayer, ComCtrls, ExtCtrls, Gauges;

com relação ao controle de som

procedure TForm1.TrackBar1Change(Sender: TObject);
var
   Count , i : longint;  // 4369
begin
   Count := waveOutGetNumDevs;
   for i := 0 to Count do
     begin
        waveOutSetVolume(i,longint(TrackBar1.position*1369)*65536+longint(TrackBar1.position*1369));
     end;
end;

deixe a propriedade Max do TrackBar1 = 22

modifique tambem essa procedure

procedure TForm1.Button8Click(Sender: TObject);
begin
   OpenMP3(fname);
   Gauge1.MaxValue := GetMP3Len;
   PlayMP3;
   Timer1.Enabled := true;
end;

vai deixar o valor maximo da musica certo

abraço

António44 · Janeiro 31, 2017

procedure ForwardMP3(ToPlace: LongInt =1);//Erro aqui
Erro expected and found (=1)
procedure RewindMP3(ToPlace: LongInt =1);
Erro expected and found (=1)

procedure TForm1.Button8Click(Sender: TObject);
begin
OpenMP3(fname);
Gauge1.MaxValue := lengthmp3(fname);
PlayMP3;
Timer1.Enabled := true;
end;

teria que alterar algo no timer ??? interval ou eanbled true ou false

Só toca a 1 faixa e quando acaba se fazer um play novamente não da nada.

O gauge1 tb não mexe.

Entrar

(Resolvido) Lista de musicas

Pergunta

Link para o comentário

Compartilhar em outros sites

38 respostass a esta questão

Posts Recomendados

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Link para o comentário

Compartilhar em outros sites

Participe da discussão

Estatísticas dos Fóruns