unit u_media;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, MPlayer, ComCtrls, MMSystem, acPNG;
type
TForm1 = class(TForm)
grp1: TGroupBox;
lbl1: TLabel;
lbl2: TLabel;
pb1: TProgressBar;
lbl3: TLabel;
scrlbr1: TScrollBar;
tmr1: TTimer;
Mplayer1: TMediaPlayer;
btn1: TSpeedButton;
btn2: TSpeedButton;
dlgOpen1: TOpenDialog;
pnl1: TPanel;
btn3: TButton;
btn4: TButton;
btn5: TButton;
btn6: TButton;
btn7: TButton;
lbl4: TLabel;
lbl5: TLabel;
list1: TListBox;
img1: TImage;
img2: TImage;
procedure btn3Click(Sender: TObject);
procedure btn7Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
procedure btn6Click(Sender: TObject);
procedure btn5Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure scrlbr1Change(Sender: TObject);
procedure pb1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure list1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
procedure play(playMP:Boolean);
procedure open;
procedure Next;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
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.Next;
begin
if (list1.Count<>0) and (list1.ItemIndex<>-1) then
begin
if list1.ItemIndex=list1.Count-1 then
begin
list1.ItemIndex:=0;
end else
if list1.ItemIndex<>list1.Count-1 then
begin
list1.ItemIndex:=list1.ItemIndex+1;
end;
end else
if list1.ItemIndex=-1 then
begin
list1.ItemIndex:=0;
end;
play(True);
end;
procedure tform1.play(playMP:Boolean);
begin
if playMP then
begin
try
Mplayer1.FileName:=list1.Items[list1.ItemIndex];
list1.Selected[list1.ItemIndex]:=True;
lbl3.Caption:=Mplayer1.FileName;
pnl1.Refresh;
Mplayer1.Display:=pnl1;
Mplayer1.Open;
pb1.Position:=Mplayer1.Position;
pb1.Max:=Mplayer1.Length;
Mplayer1.DisplayRect:=Rect(0,0,pnl1.Width,pnl1.Height);
Mplayer1.Enabled:=True;
Mplayer1.Play;
tmr1.Enabled:=True;
except
tmr1.Enabled:=false;
Next;
Play(True);
tmr1.Enabled:=True;
lbl3.Caption:=Mplayer1.FileName;
end;
end;
end;
procedure Tform1.open;
begin
dlgOpen1.Filter:='All supported files|*.mp3;*.wav;*.avi;*.mpg;*.mpeg;*.wma|Audio module files (*.mp3;*.wav;*.wma)|*.mp3;*.wav;*.wma|Video files (*.avi;*.mpg;*.mpeg)|*.avi;*.mpg;*.mpeg|All files (*.*)|*.*';
if dlgOpen1.Execute then
begin
list1.Items.AddStrings(dlgOpen1.Files);
end;
form1.Caption:='Play List: '+inttostr(list1.Count)+' items';
end;
{$R *.dfm}
procedure TForm1.btn3Click(Sender: TObject);
begin
if list1.Count<>0 then
begin
if list1.ItemIndex=0 then
begin
list1.ItemIndex:=list1.Count-1;
end else
if list1.ItemIndex<>0 then
begin
list1.ItemIndex:=list1.ItemIndex-1;
end;
end;
if list1.ItemIndex=-1 then
begin
list1.ItemIndex:=0;
end;
end;
procedure TForm1.btn7Click(Sender: TObject);
begin
if (list1.Count<>0) and (list1.ItemIndex<>-1) then
begin
if list1.ItemIndex=list1.Count-1 then
begin
list1.ItemIndex:=0;
end else
if list1.ItemIndex<>list1.Count-1 then
begin
list1.ItemIndex:=list1.ItemIndex+1;
end;
end else
if list1.ItemIndex=-1 then
begin
list1.ItemIndex:=0;
end;
play(True);
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
open;
end;
procedure TForm1.btn4Click(Sender: TObject);
begin
if lbl3.Caption='Paused' then
begin
Mplayer1.Position:=pb1.Position;
Mplayer1.Play;
lbl3.Caption:=Mplayer1.FileName;
end else
if list1.ItemIndex=-1 then
begin
list1.ItemIndex:=0;
play(True);
end else
begin
play(True);
end;
if (list1.Count=0) and (tmr1.Enabled=false) then
begin
open;
end;
end;
procedure TForm1.btn6Click(Sender: TObject);
begin
Mplayer1.Stop;
tmr1.Enabled:=false;
pb1.Position:=0;
end;
procedure TForm1.btn5Click(Sender: TObject);
begin
if (tmr1.Enabled) then
begin
Mplayer1.Pause;
lbl3.Caption:='Paused';
end else
if lbl3.Caption='Paused' then
begin
Mplayer1.Position:=pb1.Position;
Mplayer1.Play;
end;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.tmr1Timer(Sender: TObject);
begin
pb1.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.pb1MouseDown(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-pb1.Left-50) * x))));//calculates the new position of...
pb1.Position := strtoint(f);
Mplayer1.Position := strtoint(f);
if lbl3.Caption<>'Paused' then
Mplayer1.Play;
tmr1.Enabled := true;
end;
except
exit;
end;
end;
procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r:real;
begin
r:=int(pb1.Position/pb1.Max*100);
pb1.Hint:='Step: '+floattostr(r)+'%';
pb1.ShowHint:=true;
end;
procedure TForm1.list1DblClick(Sender: TObject);
begin
play(True);
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.FormDestroy(Sender: TObject);
begin
tmr1.Destroying;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
tmr1.Enabled:=false;
end;
end.
0 komentar:
Post a Comment