Jumat, 22 Juni 2012

TUGAS MEDIA PLAYER APLIKASI

unit u_mplayer;

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.

0 comments:

Posting Komentar