interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, sPanel, ComCtrls, acProgressBar, StdCtrls, sLabel,
sGroupBox, sSkinManager, sSkinProvider, Buttons, sSpeedButton, sListBox,
sButton, MMSystem, MPlayer, sScrollBar, acPNG;
type
TForm1 = class(TForm)
sknprvdr1: TsSkinProvider;
sknmngr1: TsSkinManager;
grp1: TsGroupBox;
lbl1: TsLabel;
lbl2: TsLabel;
probar1: TsProgressBar;
lbl3: TsLabel;
Panel1: TsPanel;
ListB1: TsListBox;
btn1: TsSpeedButton;
btn2: TsSpeedButton;
btn3: TsSpeedButton;
btn4: TsSpeedButton;
btn5: TsSpeedButton;
dlgOpen1: TOpenDialog;
tmr1: TTimer;
Mplayer1: TMediaPlayer;
scrlbr1: TsScrollBar;
lbl4: TsLabel;
btn7: TsSpeedButton;
img1: TImage;
procedure btn2Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn5Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure scrlbr1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure probar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure probar1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListB1DblClick(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure btn7Click(Sender: TObject);
private
{ Private declarations }
public
procedure MPPlay(PlayMp:Boolean);
procedure MPOPen;
procedure MPPrev;
procedure MPNExt;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure TForm1.MPPrev;
begin
if ListB1.Count<>0 then
begin
if ListB1.ItemIndex=0 then
begin
ListB1.ItemIndex:=ListB1.Count-1;
end else
if ListB1.ItemIndex<>0 then
begin
ListB1.ItemIndex:=ListB1.ItemIndex-1;
end;
end;
if ListB1.ItemIndex=-1 then
begin
ListB1.ItemIndex:=0;
end;
end;
procedure TForm1.MPNext;
begin
if (ListB1.Count<>0) and (ListB1.ItemIndex<>-1) then
begin
if ListB1.ItemIndex=ListB1.Count-1 then
begin
ListB1.ItemIndex:=0;
end else
if ListB1.ItemIndex<>ListB1.Count-1 then
begin
ListB1.ItemIndex:=ListB1.ItemIndex+1;
end;
end else
if ListB1.ItemIndex=-1 then
begin
ListB1.ItemIndex:=0;
end;
end;
procedure TForm1.MPPlay(PlayMp:Boolean);
begin
if PlayMP then
begin
try
Mplayer1.FileName:=ListB1.Items[ListB1.ItemIndex];
ListB1.Selected[ListB1.ItemIndex]:=true;
lbl3.Caption:=Mplayer1.FileName;
Panel1.Refresh;
Mplayer1.Display:=Panel1;
Mplayer1.Open;
probar1.Position:=Mplayer1.Position;
probar1.Max:=Mplayer1.Length;
Mplayer1.DisplayRect:=Rect(0,0,Panel1.Width,Panel1.Height);
Mplayer1.Enabled:=True;
Mplayer1.Play;
tmr1.Enabled:=true;
except
tmr1.Enabled:=false;
MPNext;
MPPLay(true);
tmr1.Enabled:=true;
lbl3.Caption:=Mplayer1.FileName;
end;
end;
end;
procedure TForm1.MPOPen;
begin
dlgOpen1.Filter:='All supported files|*.mp3;*.wav;*.avi;*.mpg;*.mpeg;;*.mp4;*.wma|Audio module files (*.mp3;*.wav;*.wma)|*.mp3;*.wav;*.wma|Video files (*.avi;*.mpg;*.mpeg;*.mp4)|*.avi;*.mpg;*.mpeg;*.mp4|All files (*.*)|*.*';
if dlgOpen1.Execute then
begin
ListB1.Items.AddStrings(dlgOpen1.Files);
end;
form1.Caption:='Play List: '+inttostr(ListB1.Count)+' items';
end;
{$R *.dfm}
function getwavevolume:byte;
var
Volume: DWord;
MyWaveOutCaps: TWaveOutCaps;
vol:real;
s:string;
begin
if WaveOutGetDevCaps(WAVE_MAPPER,@MyWaveOutCaps,sizeof(MyWaveOutCaps))=MMSYSERR_NOERROR then
begin
WaveOutGetVolume(WAVE_MAPPER, @Volume);
vol:=(Volume div 65537 div 257);
s:=floattostr(int(vol));
getwavevolume:=strtoint(s);
end;
end;
function setwavevolume(volume:DWord):Dword;
var vol:integer;
MyWaveOutCaps: TWaveOutCaps;
begin
vol:=(volume)*65537*257;
if WaveOutGetDevCaps(WAVE_MAPPER,@MyWaveOutCaps,sizeof(MyWaveOutCaps))=MMSYSERR_NOERROR then
begin
WaveOutSetVolume(WAVE_MAPPER, MakeLong(vol, vol));
end;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
if lbl3.Caption='Paused' then
begin
Mplayer1.Position:=probar1.Position;
Mplayer1.Play;
lbl3.Caption:=Mplayer1.FileName;
end else
if ListB1.ItemIndex=-1 then
begin
ListB1.ItemIndex:=0;
MPPlay(True);
end else
begin
MPPlay(True);
end;
if (ListB1.Count=0) and (tmr1.Enabled=false) then
begin
MPOpen;
end;
end;
procedure TForm1.btn4Click(Sender: TObject);
begin
Mplayer1.Stop;
tmr1.Enabled:=false;
probar1.Position:=0;
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
if (tmr1.Enabled) then
begin
Mplayer1.Pause;
lbl3.Caption:='Paused';
end else
if lbl3.Caption='Paused' then
begin
Mplayer1.Position:=probar1.Position;
Mplayer1.Play;
end;
end;
procedure TForm1.btn5Click(Sender: TObject);
begin
MPNExt;
MPPlay(True);
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
MPPrev;
MPPlay(True);
end;
procedure TForm1.tmr1Timer(Sender: TObject);
begin
probar1.Position:=Mplayer1.Position;
end;
procedure TForm1.scrlbr1Change(Sender: TObject);
var f:real;
begin
setwavevolume(scrlbr1.Position);
f:=int(scrlbr1.Position/scrlbr1.Max*100);
lbl4.Caption:=floattostr(f)+'%';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
tmr1.Destroying;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
tmr1.Enabled:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer; f:real;
begin
i:=getwavevolume;
scrlbr1.Position:=i;
f:=int(i/scrlbr1.Max*100);
lbl4.Caption:=floattostr(f)+'%';
application.HintColor:=$0046464A;
screen.HintFont.Color:=cllime;
application.HintHidePause:=2000;
end;
procedure TForm1.probar1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var f: string;
begin
try
if Button = mbLeft then
begin
f := floattostr(int(((Mplayer1.length / (Form1.Width-probar1.Left-50) * x))));//calculates the new position of...
probar1.Position := strtoint(f);
Mplayer1.Position := strtoint(f);
if lbl3.Caption<>'Paused' then
Mplayer1.Play;
tmr1.Enabled := true;
end;
except
exit;
end;
end;
procedure TForm1.probar1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r:real;
begin
r:=int(probar1.Position/probar1.Max*100);
probar1.Hint:='Step: '+floattostr(r)+'%';
probar1.ShowHint:=true;
end;
procedure TForm1.ListB1DblClick(Sender: TObject);
begin
MPPlay(True);
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
if (tmr1.Enabled) then
begin
Mplayer1.Pause;
lbl3.Caption:='Paused';
end else
if lbl3.Caption='Paused' then
begin
Mplayer1.Position:=probar1.Position;
Mplayer1.Play;
end;
end;
procedure TForm1.btn7Click(Sender: TObject);
begin
MPOPen;
end;
end.
