首页  编辑  

Mid的循环播放

Tags: /超级猛料/Multi-Media.多媒体相关/   Date Created:

]、。·ˉˇ¨〃々—～‖…’”〕〉》」』〗】∶！＂＇），．：；？］｀ 下面的程序我已实际编译运行过，随便你暂停多少次，都可以再次循环播放

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，所以就

不能循环喽，这下该结了吧。