sound.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit sound;

interface

uses
 windows,mmsystem;

function StartSound(hwnd:THandle; FileName:string):cardinal;
function PlayPos:cardinal;
procedure Replay;
procedure StopSound;

implementation

Var
 Playing:boolean=false;
 DevId:word;
 mciPlay:TMCI_PLAY_PARMS;

procedure mciError(error:integer;FileName:string);
var
 msg:array[0..128] of char;
begin
 mciGetErrorString(error,msg,SizeOf(msg));
 MessageBox(0,msg,pchar(FileName),0);
end;

function StartSound(hwnd:THandle;FileName:string):cardinal;
var
 mciOpen:TMCI_OPEN_PARMS;
 mciStat:TMCI_STATUS_PARMS;
 err:integer;
begin
 Result:=0;
 if playing then StopSound;
 with mciOpen do begin
  dwCallBack:=HWnd;
  wDeviceID:=0;
  lpstrDeviceType:=nil;
  lpstrElementName:=PChar(FileName);
  lpstrAlias:=nil;
 end;
 err:=mciSendCommand(0, mci_Open, mci_open_element or mci_Open_Shareable, Longint(@mciOpen));
 if err<>0 then begin
  mciError(err,FileName);
 end else begin
  DevId:=mciOpen.wDeviceId;

  mciStat.dwItem:=mci_Status_Length;
  mciSendCommand(DevID,mci_Status,mci_Wait or mci_Status_Item,LongInt(@mciStat));
  Result:=mciStat.dwReturn;

  mciPlay.dwCallBack:=HWnd;
  mciPlay.dwFrom    :=0;
  Playing:=(mciSendCommand( DevID, mci_Play, mci_notify or mci_from, Longint(@mciPlay))=0);
  if not playing then begin
   StopSound;
   Result:=0;
  end;
 end;
end;

function PlayPos:cardinal;
var
 mciStat:TMCI_STATUS_PARMS;
begin
 if not Playing then
  Result:=0
 else begin
  mciStat.dwItem:=mci_Status_Position;
  mciSendCommand(DevID,mci_Status,mci_Wait or mci_Status_Item,LongInt(@mciStat));
  Result:=mciStat.dwReturn;
 end;
end;

procedure Replay;
begin
 if Playing then
  mciSendCommand( DevID, mci_Play, mci_notify or mci_from, Longint(@mciPlay));
end;

procedure StopSound;
begin
 mciSendCommand( DevID, mci_Close, 0, 0);
 playing:=false;
end;

end.