DELPHI写的播放器核心代码，播放MP3无压力

本文整理自网络，侵删。

 
DELPHI写的播放器核心代码，播放MP3无压力

主窗口代码：

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, tcMMControl;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
     play : TTcPlayer;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    play := TTcPlayer.Create('demoplayer');
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    play.stop;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
    play.PlayFile('D:\MP3\getup\成龙-感受.mp3');
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
    play.stop;
end;
 
end.
单元文件：tcMMSystem.pas

unit tcMMSystem;
 
interface
 
uses MMSystem, SysUtils;
 
const
  bufflen = 512;
 
var
  mciCmd : WideString;
  mciId : WideString;
  mciResult : array[0..bufflen] of WideChar;
  mciLength : Integer;    // 媒体时间长度
  mciString : WideString;
 
// 执行多媒体命令
function doCmd : Integer;  
// 播放文件
function MciOpenFile(alias:WideString;fn:WideString):Boolean;
// 取得长度
function MciGetLength(alias:WideString):Integer;
// 播放
procedure mciplay(alias:WideString);
// 停止
procedure mcistop(alias:WideString);
// 暂停
procedure mcipause(alias:WideString);
// 关闭
procedure mciclose(alias:WideString);
// 取当前播放位置
function mciGetPosition(alias:WideString) : Integer;
// 设置播放位置
procedure mciSetPosition(alias:WideString; position: Integer);
// 取得音量
function mciGetVolume(alias:WideString): Integer;
// 设置音量
procedure mciSetVolume(alias:WideString; vol: Integer);
// 设置声道
procedure mciSetStereo(alias:WideString; source:WideString);
 
implementation
 
// 执行多媒体命令
function doCmd : Integer;
begin
  Result := mciSendStringW(PWideChar(mciCmd), mciresult, bufflen, 0);
  mciString := mciResult;
end;
 
// 播放文件
function MciOpenFile(alias:WideString;fn:WideString):Boolean;
begin
  mciclose(alias);
 
  mciCmd := 'open "' + fn + '" alias ' + alias;
  result := doCmd = 0;
 
  mciCmd := 'set '+ alias +' time format milliseconds';
  doCmd ;
end;
 
// 播放文件
//function PlayFileSid(sid:Integer):Boolean;
//var
//  snd : tcSound;
//begin
//  snd := GetSoundById(sid);
//  result := playFile(snd.path);
//  snd.Free;
//end;
 
// 取得长度
function MciGetLength(alias:WideString):Integer;
var
  s : WideString;
begin
  mciCmd := 'status '+ alias +' length';
  doCmd;          
  s := mciResult;
  result := StrToIntDef(s,0);
end;
 
// 播放
procedure mciPlay(alias:WideString);
begin
  mciCmd := 'play ' + alias;
  doCmd;
end;
 
// 停止
procedure mciStop(alias:WideString);
begin
  mciCmd := 'stop ' + alias;
  doCmd;
end;
 
// 暂停
procedure mciPause(alias:WideString);
begin
  mciCmd := 'pause ' + alias;
  doCmd;
end;
 
// 关闭
procedure mciClose(alias:WideString);
begin
  mciCmd := 'close ' + alias;
  doCmd;
end;
 
// 取当前播放位置
function mciGetPosition(alias:WideString) : Integer;
var
  s : WideString;
begin
  mciCmd := 'status ' + alias + ' position';
  doCmd;
  s := mciResult;
  result := StrToIntDef(s,0);
end;
 
// 取得音量
function mciGetVolume(alias:WideString): Integer;
begin
  mciCmd := 'status ' + alias + ' volume';
  doCmd;
  result := StrToIntDef(mciString, 0);
end;
 
// 设置音量
procedure mciSetVolume(alias:WideString; vol: Integer);
begin
  mciCmd := 'setaudio ' + alias + ' Volume to ' + inttostr(vol);
  doCmd;
end;
 
// 设置播放位置
procedure mciSetPosition(alias:WideString; position: Integer);
begin
  mciCmd := 'seek ' + alias + ' to ' + inttostr(position);
  doCmd;  
end;
 
// 设置声道
procedure mciSetStereo(alias:WideString; source:WideString);
begin
  mciCmd := 'Setaudio source to ' + Source;
  doCmd;
end;
 
end.
 
单元文件：tcMMControl.pas

unit tcMMControl;
 
interface
 
uses tcMMSystem, SysUtils;
 
const
  bufflen = 512;
 
type TTcPlayer = class(TObject)
  private
    fn : WideString;
    alias : WideString;
    fopened : Boolean;
    fplaying : Boolean;
    fpaused : Boolean;
  public
    constructor Create(alias:WideString);
    function SetFile(filename:WideString):Boolean;
    function PlayFile(filename:WideString):Boolean;
    procedure play;
    procedure stop;
    procedure close;
    procedure pause;
    procedure SetVolume(volume:Integer);
    function GetVolume:Integer;
    procedure SetPosition(Position:Integer);
    function GetPosition:Integer;
    function GetLength: Integer;
    procedure SetStereo(source: Integer);
  published
 
  property playing : Boolean read fplaying;
  property opened : Boolean read fopened;
  property paused : Boolean read fpaused;
end;
 
implementation
 
constructor TTcPlayer.Create(alias:WideString);
begin
  self.alias := alias;
  fopened := False;
  fplaying := False;
 
end;
 
procedure TTcPlayer.stop;
begin
  mcistop(alias);
  fplaying := False;
end;
 
procedure TTcPlayer.close;
begin
  if fplaying then
    stop;
 
  mciclose(alias);
  fopened := False;
  fplaying := False;
end; 
 
procedure TTcPlayer.pause;
begin
  if playing then
  begin
    if fpaused then
      play
    else
    begin
      mcipause(alias);
      fpaused := true;
    end;
  end;
end;
 
function TTcPlayer.GetVolume:Integer;
begin
  result := mciGetVolume(alias);
end;
procedure TTcPlayer.play;
begin
  if fopened then
  begin
    mciplay(alias);
    fplaying := True;
    fpaused := False;
  end;
end;
 
 
procedure TTcPlayer.SetVolume(volume:Integer);  
begin
  mciSetVolume(alias, volume);
end;
 
procedure TTcPlayer.SetPosition(Position:Integer);
begin
  mciSetPosition(alias, Position);
  if fplaying and not fpaused then
    play
end;
 
function TTcPlayer.GetPosition:Integer;
begin
  result := mciGetPosition(alias);
end;
 
function TTcPlayer.GetLength: Integer;
begin
  result := MciGetLength(alias);
end;
 
procedure TTcPlayer.SetStereo(source: Integer);
var
  src : WideString;
begin
  case source of
  0: src := 'stereo';
  1: src := 'left';
  2: src := 'right';
  else src := 'average';
  end;
  mciSetStereo(alias,src);
end;
 
 
function  TTcPlayer.SetFile(filename:WideString):Boolean;
begin
  if fopened then
    close;
  fopened := MciOpenFile(alias, filename);
  Result := fopened;
  if fopened then
    fn := filename;
end;
 
function  TTcPlayer.PlayFile(filename:WideString):Boolean;
begin
  result := SetFile(filename);
  play;
end;
 
end.
本文链接：https://blog.csdn.net/tcmakebest/article/details/17321273

 

相关阅读 >>

Delphi 设置webbrowser 代理服务器 与 useragent

Delphi gethref 获取<a href="链接"></a>中href的数据

Delphi 注入指定进程

Delphi concat 字符串函数

Delphi 检查程序是否在（vm，vpc等）虚拟机运行 Delphi(测试可用)

Delphi stringgrid常用属性和常用操作

Delphi winapi: findwindow、findwindowex - 查找窗口

Delphi 10.4.1的编译器bug终于修正了！

Delphi opendialog1 添加文件打开多选模式

Delphi recodedatetime、recodedate、recodetime、recodeyear ... 修改时间

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » DELPHI写的播放器核心代码，播放MP3无压力