Cara Membuat Aplikasi Media Player Dengan Delphi 7

unit u_media;

interface

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

type
  TForm1 = class(TForm)
    lbl3: TLabel;
    scrlbr1: TScrollBar;
    tmr1: TTimer;
    Mplayer1: TMediaPlayer;
    btn1: TSpeedButton;
    dlgOpen1: TOpenDialog;
    pnl1: TPanel;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    btn6: TButton;
    btn7: TButton;
    lbl4: TLabel;
    list1: TListBox;
    img1: TImage;
    xpmnfst1: TXPManifest;
    grp1: TGroupBox;
    lbl5: TLabel;
    lbl1: TLabel;
    img2: TImage;
    pb1: TProgressBar;
    btn2: TButton;
    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.