ueplayer.pas

用delphi编的播放器程序

     MediaPlayer.Stop;
     MediaPlayer.Rewind;
     TrackBar_Play.Position := 0;
   end;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.SpeedBtn_UpClick(Sender: TObject);
begin
  if frmPlayList.FileIndex=0 then Exit;
  if frmPlayList.FileIndex < 0 then
    MessageBox(Handle, '此时没有任何播放文件!', PChar('警告'), MB_OK+MB_ICONWARNING)
  else
    begin
      MediaPlayer.Stop;
      frmPlayList.ListBox_PlayFiles.ItemIndex := frmPlayList.ListBox_PlayFiles.ItemIndex - 1;
      MediaPlayer.FileName := frmPlayList.ListBox_PlayFiles.Items[frmPlayList.ListBox_PlayFiles.ItemIndex];
      frmplaylist.FileIndex:=frmplaylist.FileIndex-1;
      MediaPlayer.Open;
      MediaPlayer.Play;
    end;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.SpeedBtn_DownClick(Sender: TObject);
begin
  if frmPlayList.ListBox_PlayFiles.ItemIndex < 0 then
  begin
    MessageBox(Handle,'此时没有任何播放文件!',PChar('警告'),MB_OK+MB_ICONWARNING);
  end;
  frmPlayList.ListBox_PlayFiles.ItemIndex := frmPlayList.ListBox_PlayFiles.ItemIndex + 1;
  frmplaylist.FileIndex:=frmplaylist.FileIndex+1;
  if frmplaylist.FileIndex>=(frmplaylist.FileCount) then
  begin
    messagebox(handle,'后头已经没有文件了!',pchar('出错了'),MB_OK+MB_ICONWARNING);
    close;
  end
  else if frmplaylist.FileIndex<(frmplaylist.FileCount)then
  begin
    MediaPlayer.Stop;
    MediaPlayer.FileName := frmPlayList.ListBox_PlayFiles.Items[frmPlayList.ListBox_PlayFiles.ItemIndex];
    MediaPlayer.Open;
    MediaPlayer.Play;
  end;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.N2Click(Sender: TObject);
begin
  OpenDlg_Files.Options := [ofHideReadOnly,ofAllowMultiSelect,ofEnableSizing];
  try
    if OpenDlg_Files.Execute then
    begin
      frmPlayList.ListBox_PlayFiles.Items.AddStrings(OpenDlg_Files.Files);
      frmPlayList.ListBox_PlayFiles.ItemIndex := 0;
    end;
  finally
    SpeedBtn_Play.Enabled := True;
  end;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if MessageBox(Handle, '确认关闭程序吗?', '警告', MB_OKCANCEL+MB_ICONWARNING) = IDOK then
  begin
    if frmPlayList <> nil then
    frmPlayList.Free;
    Application.Terminate;
  end
  else
    Action := caNone;
end;
//==========================================================
//
//==========================================================
procedure TfrmEPlayer.FormCreate(Sender: TObject);
var
  StopTime: DWord;
begin
  StopTime := GetTickCount div 1000;
  while ((GetTickCount div 1000) < (StopTime + 1)) do
  Sleep(1);
//==========================================================
//延迟主窗口的延时程序
//==========================================================
  PositionChange := False;
end;


//==========================================================
// 打开CD-ROM
//==========================================================
procedure TfrmEPlayer.CDROM1Click(Sender: TObject);
begin
  MCISendString('set cdaudio door open wait', nil, 0, Handle);
end;


//==========================================================
// 关上CD-ROM
//==========================================================
procedure TfrmEPlayer.CDROM2Click(Sender: TObject);
begin
  MCISendString('set cdaudio door closed wait', nil, 0, Handle);
end;
//==========================================================
//下面的程序用来设置左右声道
//==========================================================
procedure TfrmEPlayer.TrackBar1Change(Sender: TObject);
var
  t, v: Longint;
begin
  t := TrackBar1.Position;
  v := (t shl 8)or(t shl 24);
  waveOutSetVolume(0, v);
{当你做一个多媒体播放器时，难免少不了控制音量的大小和左右声道的播放，
下面就介绍一种控制Wave波形输出设备音量的方法，该方法不是设置主音量。
先在窗体上放两个TTrackBar，分别命名为TrackBar1，TrackBar2，
属性Max都设置为65535，如果觉得刻度太密了，
可以把Frequency属性值设置大一些，然后在Uses段加入MMSystem，
并在TrackBar1和TrackBar2的OnChange事件都写上下列语句：

procedure TForm1.TrackBar1Change(Sender: Tobject);
var Wave:string;
begin
Wave:='$'+inttohex(TrackBar1.Position,4)+inttohex(TrackBar2.Position,4);
waveoutsetvolume(0,strtoint(Wave));
end;
/////////////////////////////////////////////
WaveOutSetVolume(hwo: Integer; dwVolume: Cardinal);

hwo is MediaPlayer1.DeviceId,

example:                           Right\/ | Left\/
dwVolume for Full L+R = $FFFFFFFF
dwVolume for Full L no R = $0000FFFF
dwVolume for Full R no L = $FFFF0000
dwVolume for no sound = $00000000
/////////////////////////////////////////////////
}
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.Timer_PlayTimer(Sender: TObject);
begin
  with MediaPlayer do
  begin
    if Mode=mpPlaying then
    begin
      if frmPlayList.IsFileChange then
     //判断播放歌曲是否已改
      begin
        TrackBar_Play.Max := Length div 1000;
        TrackBar_Play.Position := 0;
        lbl_TotalTime.Caption := '总时间: ' + ZeroFill(2, IntToStr(TrackBar_Play.max div 60))
                                 +':' + ZeroFill(2, IntToStr(TrackBar_play.max mod 60))+'    ';
   //================================================================
   //zerofill函数的作用是什么????那来的???????????
   //================================================================
        frmPlayList.IsFileChange := False;

      end;

      TrackBar_Play.Position := Position div 1000;
      lbl_PlayTime.Caption := '播放时间: ' + ZeroFill(2, IntToStr(TrackBar_Play.Position div 60))
                              + ':' + ZeroFill(2, IntToStr(TrackBar_Play.Position mod 60)) + '    ';
      //Label_Title.Caption := '当前曲目：' + '[' + ExtractFileName(frmPlayList.ListBox_PlayFiles.Items.Strings[frmPlayList.ListBox_PlayFiles.ItemIndex]) + ']';
      Label_Title.Caption := '当前曲目：' + ExtractFileName(frmPlayList.ListBox_PlayFiles.Items.Strings[frmPlayList.ListBox_PlayFiles.ItemIndex]);
    end;
  end;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.SpeedBtn_PlayClick(Sender: TObject);
var
  I: Integer;
begin
  if frmPlayList.ListBox_PlayFiles.ItemIndex < 0 then
    MessageBox(Handle,'此时没有任何播放文件!',PChar('警告'),MB_OK+MB_ICONWARNING)
  else
  for I := 0 to frmPlayList.ListBox_PlayFiles.ItemIndex do
    MediaPlayer.FileName := frmPlayList.ListBox_PlayFiles.Items.Strings[I];
    MediaPlayer.Open;
    MediaPlayer.Play;
end;
//==========================================================
//循环播放列表中的文件
//==========================================================
procedure TfrmEPlayer.btn_ShowPlayListClick(Sender: TObject);
begin
  frmPlayList := TfrmPlayList.Create(Self);
//==========================================================
//还是没有弄明白!!!!!   ????????????????????????????????????
//为什么这里不能用Application.create(TfrmPlayList,frmPlayList);????
//==========================================================
  frmPlayList.Show;
end;
//==========================================================

//==========================================================
procedure TfrmEPlayer.TrackBar_PlayChange(Sender: TObject);
begin
  if (TrackBar_Play.Position <> (Mediaplayer.Position div 1000)) then PositionChange := True
  else PositionChange := False;
    if PositionChange then
    with Mediaplayer do
    begin
      if Mode in [mpOpen, mpPlaying] then
//        等同于if(Mode=mpopen)or(mode=mpplaying)
      begin
        Pause;
        Position := TrackBar_Play.Position * 1000;
        Play;
      end
      else if mode in [mpPaused, mpStopped] then
        begin
          Position := TrackBar_play.Position * 1000;
          play;
        end;
    end;
end;
//==========================================================

//==========================================================
{procedure TfrmEPlayer.Panel1Click(Sender: TObject);
begin
  with TfrmAbout.Create(Application) do
  begin
    try
      frmAbout.ShowModal;
    finally
      Free;
    end;
  end;
end; }
//==========================================================

//==========================================================
procedure TfrmEPlayer.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  pm_right.AutoPopup:=true;
end;
//==========================================================
//实际中并没有起到作用啊????  那里出问题了????????????
//==========================================================
end.