怎样用API播放MIDI文件？

[BCB]

API 播放 MIDI的流在mmedia.hlp有介绍,
midiStreamOpen( )
midiStreamOut()
midiStreamClose( )
因涉及到回调函数,
怎样用它们播放MIDI流，
请高手指点!!!!!

[yhec]

咳，这个问题这么难？！

请问：有没有详细介绍Windows API编程方面的参考书或手册，最好有例子的书。

[Nicrosoft]

you'd better use MCI API

[BCB]

MCI API 怎样播放MIDI 文件?请写出程序

[Kingron]

这儿有一篇以前的贴子，关于MCI API播放MIDI的，供你参考：
下面的程序我已实际编译运行过，随便你暂停多少次，都可以再次循环播放
unit Unit1;

interface

uses
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.


回复人：yeah(2000-8-22 1:39:00) 得0分
下面的程序我已实际编译运行过，随便你暂停多少次，都可以再次循环播放，
其中Button1为打开并播放，Button2为暂停,Button3恢复,Button4关闭。
unit Unit1;

interface

uses
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.


回复人：drmy(2000-8-22 21:43:00) 得0分
奇怪的事情发生了。yeah兄你的程序完全正确，不过条件是运行在Windows98下，我测试过了。但是在Windows2000下如果按过pause和resume就会无法再循环播放了。我主要使用Windows2000，还请再费心了，谢谢。

回复人：yeah(2000-8-23 0:16:00) 得23分
今天看到drmy的留言，我急忙装上Win2K（开玩笑）*_^，在D5中运行一遍，果然
不行，于是代码改成这样，别说你又用D4，我要晕倒了:)
unit Unit1;

interface

uses
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，所以就
不能循环喽，这下该结了吧。

[BCB]

非常对不起，刚注销，就有人答了，
等会儿再把分送给你们！