dxsounds.pas

传奇源代码的delphi版本

    procedure Play;
    function IsPlaying: Boolean;
    procedure Stop;
    procedure Load;
    procedure Init;
    procedure LoadFromFile(const MidiFileName: string);
    procedure SaveToFile(const MidiFileName: string);
    property MusicCollection: TMusicListCollection read GetMusicListCollection;
    property IsInitialized: Boolean read FIsInitialized write FIsInitialized;
  published
    property Name;
    property Repeats: Cardinal read Frepeats write SetRepeats;
    property Duration: integer read FDuration write SetDuration;
    property StartPoint: integer read FStartPoint write SetStartPoint;
    property Midi: TMusicDataProp read FMusicDataProp write FMusicDataProp;
  end;

  {  TMusicListCollection  }

  TMusicListCollection = class(THashCollection)
  private
    FOwner: TPersistent;
    FDirectSound: IDirectSound;
  protected
    function GetItem(Index: Integer): TMusicListCollectionItem;
    procedure SetItem(Index: Integer; Value: TMusicListCollectionItem);
    procedure Update(Item: TCollectionItem); override;
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TComponent);
    function Add: TMusicListCollectionItem;
    function Find(const Name: string): TMusicListCollectionItem;
    {$IFDEF DelphiX_Spt4}
    function Insert(Index: Integer): TMusicListCollectionItem;
    {$ENDIF}
    property Items[Index: Integer]: TMusicListCollectionItem read GetItem write SetItem;
  published
  end;

  {  TDXMusic  }

  TDXMusic = class(TComponent)
  private
    FDXSound: TDXSound;
    FMidis: TMusicListCollection;
    procedure SetMidis(const value: TMusicListCollection);
    procedure SetDXSound(const Value: TDXSound);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DXSound: TDXSound read FDXSound write SetDXSound;
    property Midis: TMusicListCollection read FMidis write SetMidis;
  end;

implementation

uses DXConsts;

const
  dm_OK = 0;

function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound;
  pUnkOuter: IUnknown): HRESULT;
type
  TDirectSoundCreate = function(lpGUID: PGUID; out lplpDD: IDirectSound;
    pUnkOuter: IUnknown): HRESULT; stdcall;
begin
  Result := TDirectSoundCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCreate'))
    (lpGUID, lpDS, pUnkOuter);
end;

function DXDirectSoundEnumerate(lpCallback: TDSEnumCallbackA;
    lpContext: Pointer): HRESULT;
type
  TDirectSoundEnumerate = function(lpCallback: TDSEnumCallbackA;
    lpContext: Pointer): HRESULT; stdcall;
begin
  Result := TDirectSoundEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundEnumerateA'))
    (lpCallback, lpContext);
end;

function DXDirectSoundCaptureCreate(lpGUID: PGUID; out lplpDSC: IDirectSoundCapture;
  pUnkOuter: IUnknown): HRESULT;
type
  TDirectSoundCaptureCreate = function(lpGUID: PGUID; out lplpDD: IDirectSoundCapture;
    pUnkOuter: IUnknown): HRESULT; stdcall;
begin
  try
    Result := TDirectSoundCaptureCreate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureCreate'))
      (lpGUID, lplpDSC, pUnkOuter);
  except
    raise EDirectXError.Create(SSinceDirectX5);
  end;
end;

function DXDirectSoundCaptureEnumerate(lpCallback: TDSEnumCallbackA;
    lpContext: Pointer): HRESULT;
type
  TDirectSoundCaptureEnumerate = function(lpCallback: TDSEnumCallbackA;
    lpContext: Pointer): HRESULT; stdcall;
begin
  try
    Result := TDirectSoundCaptureEnumerate(DXLoadLibrary('DSound.dll', 'DirectSoundCaptureEnumerateA'))
      (lpCallback, lpContext);
  except
    raise EDirectXError.Create(SSinceDirectX5);
  end;
end;

var
  DirectSoundDrivers: TDirectXDrivers;
  DirectSoundCaptureDrivers: TDirectXDrivers;

function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
  lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
begin
  Result := True;
  with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
  begin
    Guid := lpGuid;
    Description := lpstrDescription;
    DriverName := lpstrModule;
  end;
end;

function EnumDirectSoundDrivers: TDirectXDrivers;
begin
  if DirectSoundDrivers=nil then
  begin
    DirectSoundDrivers := TDirectXDrivers.Create;
    try
      DXDirectSoundEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundDrivers);
    except
      DirectSoundDrivers.Free;
      raise;
    end;
  end;

  Result := DirectSoundDrivers;
end;

function EnumDirectSoundCaptureDrivers: TDirectXDrivers;
begin
  if DirectSoundCaptureDrivers=nil then
  begin
    DirectSoundCaptureDrivers := TDirectXDrivers.Create;
    try
      DXDirectSoundCaptureEnumerate(@EnumDirectSoundDrivers_DSENUMCALLBACK, DirectSoundCaptureDrivers);
    except
      DirectSoundCaptureDrivers.Free;
      raise;
    end;
  end;

  Result := DirectSoundCaptureDrivers;
end;

{  TDirectSound  }

constructor TDirectSound.Create(GUID: PGUID);
begin
  inherited Create;
  FBufferList := TList.Create;

  if DXDirectSoundCreate(GUID, FIDSound, nil)<>DS_OK then
    raise EDirectSoundError.CreateFmt(SCannotInitialized, [SDirectSound]);
end;

destructor TDirectSound.Destroy;
begin
  while BufferCount>0 do
    Buffers[BufferCount-1].Free;
  FBufferList.Free;

  FIDSound := nil;
  inherited Destroy;
end;

class function TDirectSound.Drivers: TDirectXDrivers;
begin
  Result := EnumDirectSoundDrivers;
end;

procedure TDirectSound.CheckBuffer(Buffer: TDirectSoundBuffer);
begin
  case Buffer.DXResult of
    DSERR_BUFFERLOST:
      begin
        if not FInRestoreBuffer then
        begin
          FInRestoreBuffer := True;
          try
            DoRestoreBuffer;
          finally
            FInRestoreBuffer := False;
          end;
        end;
      end;
  end;
end;

procedure TDirectSound.DoRestoreBuffer;
begin
end;

function TDirectSound.GetBuffer(Index: Integer): TDirectSoundBuffer;
begin
  Result := FBufferList[Index];
end;

function TDirectSound.GetBufferCount: Integer;
begin
  Result := FBufferList.Count;
end;

function TDirectSound.GetIDSound: IDirectSound;
begin
  if Self<>nil then
    Result := FIDSound
  else
    Result := nil;
end;

function TDirectSound.GetISound: IDirectSound;
begin
  Result := IDSound;
  if Result=nil then
    raise EDirectSoundError.CreateFmt(SNotMade, ['IDirectSound']);
end;

{  TDirectSoundBuffer  }

constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound);
begin
  inherited Create;
  FDSound := ADirectSound;
  FDSound.FBufferList.Add(Self);
end;

destructor TDirectSoundBuffer.Destroy;
begin
  IDSBuffer := nil;
  FDSound.FBufferList.Remove(Self);
  inherited Destroy;
end;

procedure TDirectSoundBuffer.Assign(Source: TPersistent);
var
  TempBuffer: IDirectSoundBuffer;
begin
  if Source=nil then
    IDSBuffer := nil
  else if Source is TWave then
    LoadFromWave(TWave(Source))
  else if Source is TDirectSoundBuffer then
  begin
    if TDirectSoundBuffer(Source).IDSBuffer=nil then
      IDSBuffer := nil
    else begin
      FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
        TempBuffer);
      if FDSound.DXResult=0 then
      begin
        IDSBuffer := TempBuffer;
      end;
    end;
  end else
    inherited Assign(Source);
end;

procedure TDirectSoundBuffer.Check;
begin
  FDSound.CheckBuffer(Self);
end;

function TDirectSoundBuffer.CreateBuffer(const BufferDesc: TDSBufferDesc): Boolean;
var
  TempBuffer: IDirectSoundBuffer;
begin
  IDSBuffer := nil;

  FDSound.DXResult := FDSound.ISound.CreateSoundBuffer(BufferDesc, TempBuffer, nil);
  FDXResult := FDSound.DXResult;
  Result := DXResult=DS_OK;
  if Result then
    IDSBuffer := TempBuffer;
end;

function TDirectSoundBuffer.GetBitCount: Longint;
begin
  Result := Format.wBitsPerSample;
end;

function TDirectSoundBuffer.GetFormat: PWaveFormatEx;
begin
  GetIBuffer;
  Result := FFormat;
end;

function TDirectSoundBuffer.GetFrequency: Integer;
begin
  DXResult := IBuffer.GetFrequency(DWORD(Result));
end;

function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer;
begin
  if Self<>nil then
    Result := FIDSBuffer
  else
    Result := nil;
end;

function TDirectSoundBuffer.GetIBuffer: IDirectSoundBuffer;
begin
  Result := IDSBuffer;
  if Result=nil then
    raise EDirectSoundBufferError.CreateFmt(SNotMade, ['IDirectSoundBuffer']);
end;

function TDirectSoundBuffer.GetPlaying: Boolean;
begin
  Result := (GetStatus and (DSBSTATUS_PLAYING or DSBSTATUS_LOOPING))<>0;
end;

function TDirectSoundBuffer.GetPan: Integer;
begin
  DXResult := IBuffer.GetPan(Longint(Result));
end;

function TDirectSoundBuffer.GetPosition: Longint;
var                                     
  dwCurrentWriteCursor: Longint;
begin
  IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
end;

function TDirectSoundBuffer.GetSize: Integer;
begin
  Result := FCaps.dwBufferBytes;
end;

function TDirectSoundBuffer.GetStatus: Integer;
begin
  DXResult := IBuffer.GetStatus(DWORD(Result));
end;

function TDirectSoundBuffer.GetVolume: Integer;
begin
  DXResult := IBuffer.GetVolume(Longint(Result));
end;

procedure TDirectSoundBuffer.LoadFromFile(const FileName: string);
var
  Stream : TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TDirectSoundBuffer.LoadFromMemory(const Format: TWaveFormatEx;
  Data: Pointer; Size: Integer);
var
  Data1, Data2: Pointer;
  Data1Size, Data2Size: Longint;
begin
  SetSize(Format, Size);

  if Data<>nil then
  begin
    if Lock(0, Size, Data1, Data1Size, Data2, Data2Size) then
    begin
      try
        Move(Data^, Data1^, Data1Size);
        if Data2<>nil then
          Move(Pointer(Longint(Data)+Data1Size)^, Data2^, Data2Size);
      finally
        UnLock;
      end;
    end else
    begin
      FIDSBuffer := nil;
      raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
    end;
  end;
end;

procedure TDirectSoundBuffer.LoadFromStream(Stream: TStream);
var  
  Wave: TWave;
begin
  Wave := TWave.Create;
  try
    Wave.LoadFromStream(Stream);
    LoadFromWave(Wave);
  finally
    Wave.Free;
  end;
end;

procedure TDirectSoundBuffer.LoadFromWave(Wave: TWave);
begin
  LoadFromMemory(Wave.Format^, Wave.Data, Wave.Size);
end;

function TDirectSoundBuffer.Lock(LockPosition, LockSize: Longint;
  var AudioPtr1: Pointer; var AudioSize1: Longint;
  var AudioPtr2: Pointer; var AudioSize2: Longint): Boolean;
begin
  Result := False;
  if IDSBuffer=nil then Exit;

  if FLockCount>High(FLockAudioPtr1) then Exit;

  DXResult := IBuffer.Lock(LockPosition, LockSize,
    FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
    FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0);
  Result := DXResult=DS_OK;

  if Result then
  begin
    AudioPtr1 := FLockAudioPtr1[FLockCount];
    AudioPtr2 := FLockAudioPtr2[FLockCount];
    AudioSize1 := FLockAudioSize1[FLockCount];
    AudioSize2 := FLockAudioSize2[FLockCount];
    Inc(FLockCount);
  end;
end;

function TDirectSoundBuffer.Play(Loop: Boolean): Boolean;
begin
  if Loop then
    DXResult := IBuffer.Play(0, 0, DSBPLAY_LOOPING)
  else
    DXResult := IBuffer.Play(0, 0, 0);
  Result := DXResult=DS_OK;
end;

function TDirectSoundBuffer.Restore: Boolean;
begin
  DXResult := IBuffer.Restore;
  Result := DXResult=DS_OK;
end;

function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean;
begin
  DXResult := IBuffer.SetFormat(FFormat^);
  Result := DXResult=DS_OK;

  if Result then
  begin
    FreeMem(FFormat);
    FFormat := nil;
    FFormatSize := 0;
    if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize))=DS_OK then
    begin
      GetMem(FFormat, FFormatSize);
      IBuffer.GetFormat(FFormat, FFormatSize, nil);
    end;             
  end;
end;

procedure TDirectSoundBuffer.SetFrequency(Value: Integer);
begin
  DXResult := IBuffer.SetFrequency(Value);
end;

procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer);
begin
  if FIDSBuffer=Value then Exit;

  FIDSBuffer := Value;
  FillChar(FCaps, SizeOf(FCaps), 0);
  FreeMem(FFormat);
  FFormat := nil;
  FFormatSize := 0;
  FLockCount := 0;

  if FIDSBuffer<>nil then
  begin
    FCaps.dwSize := SizeOf(FCaps);
    IBuffer.GetCaps(FCaps);

    if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize))=DS_OK then
    begin
      GetMem(FFormat, FFormatSize);
      IBuffer.GetFormat(FFormat, FFormatSize, nil);
    end;                 
  end;
end;

procedure TDirectSoundBuffer.SetPan(Value: Integer);
begin
  DXResult := IBuffer.SetPan(Value);
end;

procedure TDirectSoundBuffer.SetPosition(Value: Longint);
begin
  DXResult := IBuffer.SetCurrentPosition(Value);
end;

procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer);
var
  BufferDesc: TDSBufferDesc;