(******************************************************************************
 *                                                                            *
 *  Придумал и написал Кода Виктор, Март 2002                                 *
 *                                                                            *
 *  Файл:       main.pas                                                      *
 *  Содержание: Пример использования DirectSound для воспроизведения звука    *
 *                                                                            *
 ******************************************************************************)
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    btnOpen: TButton;
    odOpenFile: TOpenDialog;
    edFileName: TEdit;
    chbLoop: TCheckBox;
    bbPlay: TBitBtn;
    bbStop: TBitBtn;
    sbVolume: TScrollBar;
    sbPan: TScrollBar;
    Timer1: TTimer;
    procedure btnOpenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bbPlayClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure bbStopClick(Sender: TObject);
    procedure sbVolumeChange(Sender: TObject);
    procedure sbPanChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  WavRead,     // Класс для чтения данных из wav-файла
  DirectSound;




//------------------------------------------------------------------------------
// Константы и глобальные переменные
//------------------------------------------------------------------------------
var
  lpDS8:         IDirectSound8;
  lpSoundBuffer: IDirectSoundBuffer;
  bbytes:        Integer;            // Реальный размер буфера

  wsr:           TWaveSoundRead;     // Класс для чтения данных из wav-файла




//------------------------------------------------------------------------------
// Имя:      InitDirectSound()
// Описание: Производит инициализацию DirectSound в программе
//------------------------------------------------------------------------------
function InitDirectSound( hWnd: HWND ): Boolean;
begin
  Result := FALSE;

  // Создаём главный объект DirectSound
  if FAILED( DirectSoundCreate8( nil, lpDS8, nil ) ) then
     Exit;
  lpDS8._AddRef();

  // Устанавливаем уровень кооперации. Здесь - эксклюзивный режим
  if FAILED( lpDS8.SetCooperativeLevel( hWnd, DSSCL_PRIORITY ) ) then
     Exit;

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      ReleaseDirectSound()
// Описание: Производит удаление объектов DirectSound
//------------------------------------------------------------------------------
procedure ReleaseDirectSound();
begin
  // Удаляем звуковой буфер
  if lpSoundBuffer <> nil then
  begin
    lpSoundBuffer._Release;
    lpSoundBuffer := nil;
  end;

  // Последним удаляем главный объект DirectSound
  if lpDS8 <> nil then
  begin
    lpDS8._Release();
    lpDS8 := nil;
  end;
end;




//------------------------------------------------------------------------------
// Имя:      CreateStaticBuffer()
// Описание: Создаёт звуковой буфер DirectSound в памяти звуковой карты
//------------------------------------------------------------------------------
function CreateStaticBuffer( strFileName: string ): Boolean;
var
  dsbd8: TDSBUFFERDESC;
begin
  Result := FALSE;

  // На всякий случай разрушаем класс
  if wsr <> nil then wsr.Destroy();

  // Если буфер уже существует, то удаляем
  if lpSoundBuffer <> nil then
  begin
    lpSoundBuffer._Release;
    lpSoundBuffer := nil;
  end;

  // Создаём снова и открываем методом класса звуковой файл
  wsr := TWaveSoundRead.Create();
  if not wsr.Open( strFileName ) then
     Exit;

  // Подготавливаем структуру TDSBUFFERDESC_DX8
  ZeroMemory( @dsbd8, SizeOf( TDSBUFFERDESC ) );
  dsbd8.dwSize  := SizeOf( TDSBUFFERDESC );
  dsbd8.dwFlags := DSBCAPS_STATIC or     // Создаём в памяти звуковой карты
                   DSBCAPS_CTRLPAN or    // Буфер сможет изменять баланс звука
                   DSBCAPS_CTRLVOLUME or // Буфер сможет изменять громкость звука
                   DSBCAPS_GLOBALFOCUS;  // Единоличный звуковой вывод
  // Комментарий: к флагам можно добавить константу DSBCAPS_LOCHARDWARE и таким
  // способом проверить, поддерживает ли звуковая карта аппаратное смешивание.
  // При отсутствии этой возможности CreateSoundBuffer() вернёт вернёт ошибку

  // Вот тут и понадобился класс TWaveSoundRead - после открытия звукового файла
  // переменные класса содержат количество байт, прочитанных в файле и специаль-
  // нам образом заполненную структуру типа WAVEFORMATEX. Передаём эти значения
  // DirectSound - если этого не сделать, при создании буфера возникнет ошибка
  dsbd8.dwBufferBytes := wsr.m_ckIn.cksize;
  dsbd8.lpwfxFormat   := wsr.m_pwfx;

  // Теперь можно создать звуковой буфер
  if FAILED( lpDS8.CreateSoundBuffer( dsbd8, lpSoundBuffer, nil ) ) then
     Exit;
  lpSoundBuffer._AddRef();

  // Запоминаем реальный размер созданного звукового буфера DirectSound
  bbytes := dsbd8.dwBufferBytes;

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      FillBuffer()
// Описание: Заполняет звуковой буфер DirectSound данными из wav-файла
//------------------------------------------------------------------------------
function FillBuffer( var (* по параметру *)lpBuffer: IDirectSoundBuffer ): Boolean;
var
  pbWavData: PByte;
  cbWavSize: UINT;
  pbData:    Pointer;
  pbData2:   Pointer;
  dwLength:  DWORD;
  dwLength2: DWORD;
  nWaveFileSize: Integer;
begin
  Result := FALSE;

  pbData  := nil;
  pbData2 := nil;

  // Запоминаем размер звуковых данных
  nWaveFileSize := wsr.m_ckIn.cksize;


  // Выделяем паамять для буфера
  // Вот так в SDK
  // pbWavData = new BYTE[ nWaveFileSize ]
  // Вот так тут
  GetMem( pbWavData, nWaveFileSize );
  // А если так: GetMem( pbWavData, Byte( nWaveFileSize ) ) - то ошибка
  // Почему - не знаю!



  // Проверяем, выделилась ли нам память
  if pbWavData = nil then
     Exit;

  // Читаем данные из файла в буфер
  if not wsr.Read( nWaveFileSize, pbWavData, @cbWavSize ) then
     Exit;

  // Устанавливаем позицию на начало файла
  wsr.Reset();

  // Блокируем буфер (это часть механизма заполнения)
  if FAILED( lpSoundBuffer.Lock( 0, bbytes, pbData, dwLength, pbData2, dwLength2, 0 ) ) then
     Exit;

  // Копируем участок памяти буфера в звуковой буфер DirectSound
  CopyMemory( pbData, pbWavData, bbytes );

  // Не зыбываем разблокировать буфер
  if FAILED( lpSoundBuffer.Unlock( pbData, bbytes, nil, 0 ) ) then
     Exit;

  pbData := nil;

  // Больше не нуждаемся в области с данными, удаляем её
  FreeMem( pbWavData, nWaveFileSize );
  pbWavData := nil;                    

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormCreate()
// Описание: Производит инициализацию DirectSound при старте программы
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  if not InitDirectSound( Form1.Handle ) then
  begin
     MessageBox( Form1.Handle, 'Ошибка при инициализации DirectSound!',
                'Ошибка!', MB_ICONHAND );
     ReleaseDirectSound();
     Halt;
  end;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.btnOpenClick()
// Описание: По щелчку на кнопке открывает wav-файл и подготавливает UI
//------------------------------------------------------------------------------
procedure TForm1.btnOpenClick(Sender: TObject);
begin
  if odOpenFile.Execute then
  if ( CreateStaticBuffer( odOpenFile.FileName ) ) and ( FillBuffer( lpSoundBuffer ) )
  then
  begin
    edFileName.Text := odOpenFile.FileName; // Показываем имя открытого файла
    bbPlay.Enabled := TRUE;                 // Кнопка проигрывания - доступна
  end;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.bbPlayClick()
// Описание: Начинает проигрывание данных из звукового буфера
//------------------------------------------------------------------------------
procedure TForm1.bbPlayClick(Sender: TObject);
begin
   // Если выбрана опция циклического проигрывания - принимаем к этому меры
   if chbLoop.Checked then lpSoundBuffer.Play( 0, 0, DSBPLAY_LOOPING )
                      else lpSoundBuffer.Play( 0, 0, 0 );
   btnOpen.Enabled := FALSE; // Кнопка открытия файла - неактивна
   bbPlay.Enabled  := FALSE; // Кнопка проигрывания - неактивна
   bbStop.Enabled  := TRUE;  // Кнопка останова - доступна
   Timer1.Enabled  := TRUE;  // Включаем таймер
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.bbStopClick()
// Описание: Останавливает проигрывание данных из звукового буфера
//------------------------------------------------------------------------------
procedure TForm1.bbStopClick(Sender: TObject);
begin
  lpSoundBuffer.Stop();                  // Останавливаем воспроизведение
  lpSoundBuffer.SetCurrentPosition( 0 ); // Устанавливаем позицию на начало данных
  bbStop.Enabled  := FALSE;              // Подготавливаем UI...
  bbPlay.Enabled  := TRUE;               // ...
  btnOpen.Enabled := TRUE;               // ...
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.sbVolumeChange()
// Описание: Меняет громкость звука в колонках
//------------------------------------------------------------------------------
procedure TForm1.sbVolumeChange(Sender: TObject);
begin
  lpSoundBuffer.SetVolume( sbVolume.Position );
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.sbPanChange()
// Описание: Производит эффект "перетекания" звука из одной колонки в другую
//------------------------------------------------------------------------------
procedure TForm1.sbPanChange(Sender: TObject);
begin
  lpSoundBuffer.SetPan( sbPan.Position );
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.Timer1Timer()
// Описание: Проверяет буфер на окончание проигрывания
//------------------------------------------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
var
  dwStatus: DWORD;
begin
  // Получаем статус буфера, данные записываются в переменную dwStatus
  lpSoundBuffer.GetStatus( dwStatus );

  // Если буфер не проигрывается, то приводим UI в соответствующиё вид
  if ( dwStatus and DSBSTATUS_PLAYING ) <> DSBSTATUS_PLAYING then
  begin
    bbStop.Enabled  := FALSE; // Кнопка останова - неактивна
    bbPlay.Enabled  := TRUE;  // Кнопка проигрывания - доступна
    btnOpen.Enabled := TRUE;  // Кнопка открытия файла - доступна
  end;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormDestroy()
// Описание: Вызывается при удалении программы из памяти
//------------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReleaseDirectSound();
end;

end.