player.pas

一个非常好用的MP3音乐播放控件

unit Player;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ExtCtrls, ComCtrls, XaudioPlayer, Slider;

type
  TPlayerForm = class(TForm)
    PlayButton: TBitBtn;
    MainMenu: TMainMenu;
    StopButton: TBitBtn;
    PauseButton: TBitBtn;
    MainMenu_File: TMenuItem;
    MainMenu_File_OpenFileItem: TMenuItem;
    MainMenu_File_OpenURLItem: TMenuItem;
    VolumeButton: TSpeedButton;
    OpenFileDialog: TOpenDialog;
    MainBevel: TBevel;
    MainMenu_Help: TMenuItem;
    MainMenu_Help_AboutItem: TMenuItem;
    InputNameText: TStaticText;
    TimecodeText: TStaticText;
    DurationText: TStaticText;
    StatusBar: TStatusBar;
    XaudioPlayer: TXaudioPlayer;
    MainMenu_Windows: TMenuItem;
    MainMenu_Windows_ShowInfo: TMenuItem;
    MainMenu_Windows_Equalizer: TMenuItem;
    StreamMimeTypeText: TStaticText;
    StreamPropertiesList: TListBox;
    StreamParametersText: TStaticText;
    TrackImage: TImage;
    ThumbNormalImage: TImage;
    ThumbHighlightedImage: TImage;
    ThumbClickedImage: TImage;
    procedure MainMenu_File_OpenFileItemClick(Sender: TObject);
    procedure XaudioPlayerNotifyInputState(Sender: TXaudioPlayer;
      State: Integer);
    procedure MainMenu_File_OpenURLItemClick(Sender: TObject);
    procedure XaudioPlayerNotifyNack(Sender: TXaudioPlayer; Command: Byte;
      Code: Smallint);
    procedure XaudioPlayerNotifyProgress(Sender: TXaudioPlayer; Source,
      Code: Byte; Value: Smallint; const Msg: String);
    procedure XaudioPlayerNotifyInputPosition(Sender: TXaudioPlayer;
      Offset, Range: Cardinal);
    procedure XaudioPlayerNotifyInputTimecode(Sender: TXaudioPlayer; Hours,
      Minutes, Seconds, Fractions: Byte);
    procedure FormDestroy(Sender: TObject);
    procedure VolumeButtonClick(Sender: TObject);
    procedure PlayButtonClick(Sender: TObject);
    procedure PauseButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure MainMenu_Windows_ShowInfoClick(Sender: TObject);
    procedure XaudioPlayerNotifyOutputState(Sender: TXaudioPlayer;
      State: Integer);
    procedure XaudioPlayerNotifyOutputVolume(Sender: TXaudioPlayer;
      MasterLevel, PcmLevel, Balance: Byte);
    procedure XaudioPlayerNotifyOutputPcmLevel(Sender: TXaudioPlayer;
      PcmLevel: Byte);
    procedure XaudioPlayerNotifyOutputMasterLevel(Sender: TXaudioPlayer;
      MasterLevel: Byte);
    procedure XaudioPlayerNotifyOutputBalance(Sender: TXaudioPlayer;
      Balance: Byte);
    procedure MainMenu_Windows_EqualizerClick(Sender: TObject);
    procedure XaudioPlayerNotifyPlayerState(Sender: TXaudioPlayer;
      State: Integer);
    procedure XaudioPlayerNotifyReady(Sender: TObject);
    procedure SliderChange(Sender: TObject);
    procedure SliderMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SliderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure XaudioPlayerNotifyInputModule(Sender: TXaudioPlayer;
      ID: SmallInt);
    procedure XaudioPlayerNotifyInputName(Sender: TXaudioPlayer;
      const Name: String);
    procedure XaudioPlayerNotifyInputModuleInfo(Sender: TXaudioPlayer; ID,
      NbDevices: Byte; const Name, Description: String);
    procedure XaudioPlayerNotifyInputDeviceInfo(Sender: TXaudioPlayer;
      ModuleID, Index, Flags: Byte; const Name, Description: String);
    procedure XaudioPlayerNotifyOutputModule(Sender: TXaudioPlayer;
      ID: SmallInt);
    procedure XaudioPlayerNotifyOutputName(Sender: TXaudioPlayer;
      const Name: String);
    procedure XaudioPlayerNotifyOutputModuleInfo(Sender: TXaudioPlayer; ID,
      NbDevices: Byte; const Name, Description: String);
    procedure XaudioPlayerNotifyOutputDeviceInfo(Sender: TXaudioPlayer;
      ModuleID, Index, Flags: Byte; const Name, Description: String);
    procedure XaudioPlayerNotifyCodecModuleInfo(Sender: TXaudioPlayer; ID,
      NbDevices: Byte; const Name, Description: String);
    procedure XaudioPlayerNotifyCodecDeviceInfo(Sender: TXaudioPlayer;
      ModuleID, Index, Flags: Byte; const Name, Description: String);
    procedure FormCreate(Sender: TObject);
    procedure XaudioPlayerNotifyStreamMimeType(Sender: TXaudioPlayer;
      MimeType: String);
    procedure XaudioPlayerNotifyStreamParameters(Sender: TXaudioPlayer;
      Frequency: Cardinal; Bitrate: Smallint; NbChannels: Byte);
    procedure XaudioPlayerNotifyStreamDuration(Sender: TXaudioPlayer;
      Duration: Cardinal);
    procedure XaudioPlayerNotifyStreamProperties(Sender: TXaudioPlayer;
      NbProperties: Cardinal; Properties: PXA_Property);
  private
    { Private declarations }
    Tracking: Boolean;
    Slider: TSlider;
  public
    { Public declarations }
  end;

var
  PlayerForm: TPlayerForm;

implementation

uses URLEntry, Volume, Info, Equalizer, Modules;

{$R *.DFM}

procedure ShowError(Text: String; Code: Integer);
var
  Msg: String;
begin
  Msg := Text + ' (' + PlayerForm.XaudioPlayer.ErrorString(code) + ')';
  MessageDlg(Msg, mtError, [mbOK], 0);
end;

procedure TPlayerForm.FormCreate(Sender: TObject);
begin
  XaudioPlayer.Init;
  Slider := TSlider.Create(self);
  Slider.Parent := self;
  Slider.ThumbNormal := ThumbNormalImage.Picture.Bitmap;
  Slider.ThumbHighlighted := ThumbHighlightedImage.Picture.Bitmap;
  Slider.ThumbClicked := ThumbClickedImage.Picture.Bitmap;
  Slider.Track := TrackImage.Picture.Bitmap;
  Slider.Minimum := 0;
  Slider.Maximum := 400;
  Slider.Left := 8;
  Slider.Top := 30;
  Slider.Width := Slider.Track.Width;
  Slider.Height := Slider.Track.Height;
  Slider.OnChange := SliderChange;
  Slider.OnMouseDown := SliderMouseDown;
  Slider.OnMouseUp := SliderMouseUp;
  Tracking := False;
end;

procedure TPlayerForm.MainMenu_File_OpenFileItemClick(Sender: TObject);
begin
  if OpenFileDialog.Execute then
  begin
    XaudioPlayer.InputOpen(OpenFileDialog.FileName);
  end
end;

procedure TPlayerForm.XaudioPlayerNotifyInputState(Sender: TXaudioPlayer;
  State: Integer);
begin
  if State = XA_INPUT_STATE_OPEN then
    begin
      PlayButton.Enabled := True;
      PauseButton.Enabled := True;
      StopButton.Enabled := True;
      XaudioPlayer.Play;
    end
  else
    begin
      PlayButton.Enabled := False;
      PauseButton.Enabled := False;
      StopButton.Enabled := False;
    end;
end;

procedure TPlayerForm.MainMenu_File_OpenURLItemClick(Sender: TObject);
begin
  URLEntryForm.ShowModal;
end;

procedure TPlayerForm.XaudioPlayerNotifyNack(Sender: TXaudioPlayer;
  Command: Byte; Code: Smallint);
begin
  case Command of
  XA_MSG_COMMAND_INPUT_OPEN:
    ShowError('Cannot Open Input', Code);

  XA_MSG_COMMAND_PLAY:
    ShowError('Cannot Play Stream', Code);
  end;

end;

procedure TPlayerForm.XaudioPlayerNotifyProgress(Sender: TXaudioPlayer;
  Source, Code: Byte; Value: Smallint; const Msg: String);
begin
  case Code of
    16: StatusBar.Panels[0].Text := Msg;
    17: StatusBar.Panels[0].Text := Msg;
  end;
end;

procedure TPlayerForm.XaudioPlayerNotifyInputPosition(
  Sender: TXaudioPlayer; Offset, Range: Cardinal);
begin
  if Tracking then Exit;
  Slider.Position := Offset * (Range div (Slider.Maximum - Slider.Minimum));
end;

procedure TPlayerForm.XaudioPlayerNotifyInputTimecode(
  Sender: TXaudioPlayer; Hours, Minutes, Seconds, Fractions: Byte);
begin
  TimecodeText.Caption := Format('%.2d:%.2d:%.2d', [Hours, Minutes, Seconds]);
end;

procedure TPlayerForm.FormDestroy(Sender: TObject);
begin
  XaudioPlayer.OutputReset;
end;

procedure TPlayerForm.SliderChange(Sender: TObject);
begin
  XaudioPlayer.InputSeek(Slider.Position, Slider.Maximum);
end;

procedure TPlayerForm.SliderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Tracking := True;
end;

procedure TPlayerForm.SliderMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Tracking := False;
end;

procedure TPlayerForm.VolumeButtonClick(Sender: TObject);