请问如何在Delphi中调用API函数播放MIDI音乐？

Question

cb程序,自己改造一下吧
打开设备
            MCIERROR mciError;
            char outBuf[100];
            AnsiString Cmd="open ";
            Cmd=Cmd+File+ " type sequencer alias "+Alias;
            // File:midi文件
            mciError=mciSendString(
                Cmd.c_str(),outBuf,sizeof(outBuf),File);
            if(mciError)
            {
                mciGetErrorString(mciError,outBuf,sizeof(outBuf));
                Application->MessageBox(outBuf,"错误",
                    MB_SYSTEMMODAL+MB_OK+ MB_ICONSTOP);
            }
播放midi
            AnsiString Cmd="play ";
            Cmd=Cmd+" "+Alias+" notify";
            HWND hWnd=Application->Handle;
            MCIERROR mciError=mciSendString(Cmd.c_str(),NULL,0,hWnd);
            if(mciError)
            {
                char Buf[100];
                mciGetErrorString(mciError,Buf,sizeof(Buf));
                Application->MessageBox(Buf,"错误",
                    MB_SYSTEMMODAL+MB_OK+ MB_ICONSTOP);
            }
停止播放
            MCIERROR mciError;
            AnsiString Cmd="stop ";
            Cmd=Cmd+Alias;
            mciError=mciSendString(Cmd.c_str(),NULL,0,NULL);
            if(mciError)
            {
                char Buf[100];
                mciGetErrorString(mciError,Buf,sizeof(Buf));
                Application->MessageBox(Buf,"错误",
                    MB_SYSTEMMODAL+MB_OK+ MB_ICONSTOP);
            }
关闭设备
            AnsiString Cmd="close ";
            Cmd=Cmd+Alias;
            mciSendString(Cmd.c_str(),NULL,0,NULL);

Answer 1

直接这样用:
播放
mcisendstring('play '+'C:\windows\media\canyon.mid',nil,0,0);
停止
mcisendstring('Close '+'C:\windows\media\canyon.mid',nil,0,0);

Answer 2

完整的代码
var
  Form1: TForm1;implementation{$R *.DFM}
uses mmsystem;
procedure TForm1.Button1Click(Sender: TObject);
Var fileName:String;
begin
 filename:='C:\windows\media\canyon.mid';
 mcisendstring(PChar('Open '+filename+' alias mid'),nil,0,0);
 mcisendstring('play mid',nil,0,0);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
 mcisendstring('pause mid',nil,0,0);
 mcisendstring('stop mid',nil,0,0);
 mcisendstring('close mid',nil,0,0);
end;
其它的MCI 命令String可查API帮助

Answer 3

最简单的方法是使用Mediaplayer，好象是在Notify什么事件，
然后根据当将的Mode判断，如果为Stopped则重新播放,如果一定要用API
我临时想的，加一个Timer
在OnTime事件中，(同样使用上面的别名Mid)
Var Buf:Array[0..20] of char;
begin
  MciSendString('Status mid mode',buf,20,0);
  if strpas(buf)='stopped' then
  begin
    mcisendstring('seek mid start',nil,0,0);
    mcisendstring('play mid',nil,0,0);
  end;
  end;

Answer 4

谢谢yeah,先给你15分，等有了更好的办法在给你其它分。
wxa也给你5分，别怪我。

Answer 5

不甘心，再次使用纯API来解决，去掉Timer，改用MCISendString中的回调功能
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, mmSystem;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  protected
      procedure MMNotify(var Message: TMessage); message MM_MCINOTIFY;
  private    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
  mcisendstring('open c:\123.mid alias mid',nil,0,0);
  mcisendstring('play mid notify',nil,0,handle);
end;procedure TForm1.MMNotify(var Message: TMessage);
Var Buf:Array[0..4095] of Char;
begin
  MCISendString('status mid mode',Buf,Sizeof(Buf),0);
  if Strpas(Buf)='stopped' then
  begin
    MciSendString('Seek mid to start',nil,0,0);
    MciSendString('Play mid notify',nil,0,handle);
  end;
end;end.
哈哈，这下该结了吧。^_^

Answer 6

yeah兄，不能结！
你的法确实有效，但是我的程序中还有两个按钮，一个用于暂停播放（pause），一个用于恢复播放(resume).按完这两个按钮后，midi播放完毕时便不能循环播放了。我用的也是mcisendstring,怎麽都试不行。好人做到底吧！

Answer 7

暂停
proceure TForm1.Button2Click(Sender:TObject);
begin
  mcisendstring('pause mid',nil,0,Handle);
end;恢复时再次调用Play mid notify 即可

Answer 8

错了，应该是pause mid notify

Answer 9

yeah兄：
按你所说，还是不行。

Answer 10

下面的程序我已实际编译运行过，随便你暂停多少次，都可以再次循环播放
unit Unit1;interfaceuses
  Windows, Messages, mmsystem,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  protected
    procedure MCINotify(Var Message:TMessage);Message MM_MCINOTIFY;
  private
    function SendMCIStr(Const Value:String):PChar;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMciStr('Open C:\123.mid alias mid');
  SendMciStr('Play mid notify');
end;procedure TForm1.MCINotify(var Message: TMessage);
begin
  if SendMciStr('Status mid mode')='stopped' then
  begin
    SendMciStr('Seek mid to start');
    SendMciStr('Play mid notify');
  end;
end;function TForm1.SendMCIStr(const Value: String):PChar;
Var Buf:Array[0..4095] of char;
begin
  MCISendString(PChar(Value),Buf,Sizeof(Buf),Handle);
  Result:=Buf;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  SendMCiStr('Pause mid notify');
end;procedure TForm1.Button3Click(Sender: TObject);
begin
   SendMCiStr('Play mid notify');
end;procedure TForm1.Button4Click(Sender: TObject);
begin
   SendMciStr('Close mid');
end;end.

Answer 11

下面的程序我已实际编译运行过，随便你暂停多少次，都可以再次循环播放，
其中Button1为打开并播放，Button2为暂停,Button3恢复,Button4关闭。
unit Unit1;interfaceuses
  Windows, Messages, mmsystem,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  protected
    procedure MCINotify(Var Message:TMessage);Message MM_MCINOTIFY;
  private
    function SendMCIStr(Const Value:String):PChar;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMciStr('Open C:\123.mid alias mid');
  SendMciStr('Play mid notify');
end;procedure TForm1.MCINotify(var Message: TMessage);
begin
  if SendMciStr('Status mid mode')='stopped' then
  begin
    SendMciStr('Seek mid to start');
    SendMciStr('Play mid notify');
  end;
end;function TForm1.SendMCIStr(const Value: String):PChar;
Var Buf:Array[0..4095] of char;
begin
  MCISendString(PChar(Value),Buf,Sizeof(Buf),Handle);
  Result:=Buf;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  SendMCiStr('Pause mid notify');
end;procedure TForm1.Button3Click(Sender: TObject);
begin
   SendMCiStr('Play mid notify');
end;procedure TForm1.Button4Click(Sender: TObject);
begin
   SendMciStr('Close mid');
end;end.

Answer 12

奇怪的事情发生了。yeah兄你的程序完全正确，不过条件是运行在Windows98下，我测试过了。但是在Windows2000下如果按过pause和resume就会无法再循环播放了。我主要使用Windows2000，还请再费心了，谢谢。

Answer 13

今天看到drmy的留言，我急忙装上Win2K（开玩笑）*_^，在D5中运行一遍，果然
不行，于是代码改成这样，别说你又用D4，我要晕倒了:)
unit Unit1;interfaceuses
  Windows, Messages, mmsystem,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  protected
    procedure MCINOTIFY(Var Message:TMessage); message MM_MCINOTIFY;
  private
    nowloop:boolean;
    function SendMCIStr(Const Msg:String):PChar;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}{打开并播放}
procedure TForm1.Button1Click(Sender: TObject);
begin
 SendMciStr('open c:\123.mid alias mid');
 Sendmcistr('play mid notify');
 Nowloop:=true;
end;{Callback}
procedure TForm1.MCINOTIFY(var Message: TMessage);
begin
 if nowloop and (SendmciStr('Status mid mode')='stopped') then
 begin
   sendmcistr('seek mid to start');
   sendmcistr('play mid notify');
 end;
end;{暂停(实际上是停止，但效果一样)}
procedure TForm1.Button2Click(Sender: TObject);
begin
  nowloop:=False;
  mcisendstring('stop mid',nil,0,0);
end;{恢复(实际上是从当前位置播放，效果一样,
因为SEQ设备不支持Resume命令)}
procedure TForm1.Button3Click(Sender: TObject);
begin
  nowloop:=true;
  sendmcistr('play mid notify');
end;{关闭}
procedure TForm1.Button4Click(Sender: TObject);
begin
  sendmcistr('close mid');
end;{公用函数}
function TForm1.SendMCIStr(const Msg: String): PChar;
Var Buf:Array[0..4095] of Char;
begin
  MciSendString(PChar(msg),Buf,sizeof(buf),Handle);
  Result:=Buf;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  button4click(nil);
end;end.
前面那个程序在Win2k不行的原因，我跟踪了一下，原来在Win2k下的Callback中，
只要发送了Pause命令，下次再调用play，在Callback中mode仍为paused，所以就
不能循环喽，这下该结了吧。

Answer 14

yeah兄,这次真的解决问题了!太谢谢你了!
wxz兄,我其实也很喜欢bcb的,只是近来常用delphi而已.