Урок на Делфи 55. Аудио плеер
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Grids, Vcl.StdCtrls,
Vcl.MPlayer, Vcl.ComCtrls,FileCtrl,MMsystem;
type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
MediaPlayer1: TMediaPlayer;
ListBox1: TListBox;
Button1: TButton;
Timer1: TTimer;
TrackBar2: TTrackBar;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
chet:integer;
implementation
procedure SetVolume(const volL, volR: Word);
var hWO: HWAVEOUT;
waveF: TWAVEFORMATEX;
vol: DWORD;
begin
FillChar(waveF, SizeOf(waveF), 0);
waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
vol := volL + volR shl 16;
waveOutSetVolume(hWO, vol);
waveOutClose(hWO);
end;
{$R *.dfm}
Procedure ScanDir(StartDir: String; Mask:string; List:TStrings);
Var SearchRec : TSearchRec;
Begin
IF Mask ='' then Mask:= '*.*';
IF StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
IF FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
Begin
Repeat
IF (SearchRec.Attr and faDirectory) <> faDirectory then
begin
if (pos ('.mp3',SearchRec.Name)>0)OR (pos ('.wav',SearchRec.Name)>0) then
List.Add(StartDir + SearchRec.Name);
end
else
IF (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
Begin
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
End;
Until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
End; {IF}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dir:string;
begin
SelectDirectory(' ','',dir);
ScanDir(dir,'',ListBox1.Items);
Label1.Caption:=ExtractFileName(ListBox1.Items[chet]);
MediaPlayer1.FileName:=ListBox1.Items[chet];
MediaPlayer1.Open;
MediaPlayer1.AutoOpen:=true;
Timer1.Enabled:=true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SetVolume(32000,32000);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
chet:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
TrackBar1.Max:=MediaPlayer1.Length;
TrackBar1.Position:=MediaPlayer1.Position;
if MediaPlayer1.Position=MediaPlayer1.Length then
begin
if chet
chet:=chet+1;
MediaPlayer1.FileName:=ListBox1.Items[chet];
Label1.Caption:=ExtractFileName(ListBox1.Items[chet]);
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
if chet=ListBox1.Count-1 then
chet:=-1;
end;
end;
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
SetVolume(TrackBar2.Position*1000, TrackBar2.Position*1000);
end;
end.