Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Использование DirectSound на Delphi

Рабочий пример использования DirectSound на Delphi + несколько полезных процедур. В этом примере создается один первичный SoundBuffer и 2 статических, вторичных; в них загружаются 2 WAV файла. Первичный буфер создается процедурой AppCreateWritePrimaryBuffer, а любой вторичный - AppCreateWritePrimaryBuffer. Так как вторичный буфер связан с WAV файлом, то при создании буфера нужно определить его параметры в соответствии со звуковым файлом, эти характеристики (Samples, Bits, IsStereo) задаются в виде параметров процедуры. Time - время WAV'файла в секундах (округление в сторону увеличения).


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    DirectSound: IDirectSound;
    DirectSoundBuffer: IDirectSoundBuffer;
    SecondarySoundBuffer: array [0..1] of IDirectSoundBuffer;
    procedure AppCreateWritePrimaryBuffer;
    procedure AppCreateWriteSecondaryBuffer(var Buffer: IDirectSoundBuffer;
      SamplesPerSec: Integer; Bits: Word; isStereo:Boolean; Time: Integer);
    procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer;
      OffSet: DWord; var SoundData; SoundBytes: DWord);
    procedure CopyWAVToBuffer(name: PChar; var Buffer: IDirectSoundBuffer);
  public
    { Public declarations }
end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then
    raise Exception.Create('Failed to create IDirectSound object');
  AppCreateWritePrimaryBuffer;
  AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[0], 22050, 8, False, 10);
  AppCreateWriteSecondaryBuffer(SecondarySoundBuffer[1], 22050, 16, True, 1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: ShortInt;
begin
  if Assigned(DirectSoundBuffer) then
    DirectSoundBuffer.Release;
  for i:=0 to 1 do
    if Assigned(SecondarySoundBuffer[i]) then
      SecondarySoundBuffer[i].Release;
  if Assigned(DirectSound) then
    DirectSound.Release;
end;

procedure TForm1.AppWriteDataToBuffer;
var
  AudioPtr1, AudioPtr2: Pointer;
  AudioBytes1, AudioBytes2: DWord;
  h: HResult;
  Temp: Pointer;
begin
  H:=Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
  AudioPtr2, AudioBytes2, 0);
  if H = DSERR_BUFFERLOST then
  begin
    Buffer.Restore;
    if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1,
    AudioPtr2, AudioBytes2, 0) <> DS_OK then
      raise Exception.Create('Unable to Lock Sound Buffer');
  end
  else
  if H <> DS_OK then
    raise Exception.Create('Unable to Lock Sound Buffer');
  Temp := @SoundData;
  Move(Temp^, AudioPtr1^, AudioBytes1);
  if AudioPtr2 <> nil then
  begin
    Temp:=@SoundData; Inc(Integer(Temp), AudioBytes1);
    Move(Temp^, AudioPtr2^, AudioBytes2);
  end;
  if Buffer.UnLock(AudioPtr1, AudioBytes1,AudioPtr2, AudioBytes2) <> DS_OK then
    raise Exception.Create('Unable to UnLock Sound Buffer');
end;

procedure TForm1.AppCreateWritePrimaryBuffer;
var
  BufferDesc: DSBUFFERDESC;
  Caps: DSBCaps;
  PCM: TWaveFormatEx;
begin
  FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
  FillChar(PCM, SizeOf(TWaveFormatEx),0);
  with BufferDesc do
  begin
    PCM.wFormatTag:=WAVE_FORMAT_PCM;
    PCM.nChannels:=2;
    PCM.nSamplesPerSec:=22050;
    PCM.nBlockAlign:=4;
    PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM.wBitsPerSample:=16;
    PCM.cbSize:=0;
    dwSize:=SizeOf(DSBUFFERDESC);
    dwFlags:=DSBCAPS_PRIMARYBUFFER;
    dwBufferBytes:=0;
    lpwfxFormat:=nil;
  end;
  if DirectSound.SetCooperativeLevel(Handle,DSSCL_WRITEPRIMARY) <> DS_OK then
    raise Exception.Create('Unable to set Coopeative Level');
  if DirectSound.CreateSoundBuffer(BufferDesc,DirectSoundBuffer,nil) <> DS_OK then
    raise Exception.Create('Create Sound Buffer failed');
  if DirectSoundBuffer.SetFormat(PCM) <> DS_OK then
    raise Exception.Create('Unable to Set Format ');
  if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK then
    raise Exception.Create('Unable to set Coopeative Level');
end;

procedure TForm1.AppCreateWriteSecondaryBuffer;
var
  BufferDesc: DSBUFFERDESC;
  Caps: DSBCaps;
  PCM: TWaveFormatEx;
begin
  FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);
  FillChar(PCM, SizeOf(TWaveFormatEx),0);
  with BufferDesc do
  begin
    PCM.wFormatTag:=WAVE_FORMAT_PCM;
    if isStereo then PCM.nChannels:=2 else PCM.nChannels:=1;
    PCM.nSamplesPerSec:=SamplesPerSec;
    PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;
    PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;
    PCM.wBitsPerSample:=Bits;
    PCM.cbSize:=0;
    dwSize:=SizeOf(DSBUFFERDESC);
    dwFlags:=DSBCAPS_STATIC;
    dwBufferBytes:=Time*PCM.nAvgBytesPerSec;
    lpwfxFormat:=@PCM;
  end;
  if DirectSound.CreateSoundBuffer(BufferDesc,Buffer,nil) <> DS_OK then
    raise Exception.Create('Create Sound Buffer failed');
end;

procedure TForm1.CopyWAVToBuffer;
var
  Data: PChar;
  FName: TFileStream;
  DataSize: DWord;
  Chunk: string[4];
  Pos: Integer;
begin
  FName:=TFileStream.Create(name,fmOpenRead);
  Pos:=24;
  SetLength(Chunk,4);
  repeat
    FName.Seek(Pos, soFromBeginning);
    FName.read(Chunk[1],4);
    Inc(Pos);
  until
    Chunk = 'data';
  FName.Seek(Pos+3, soFromBeginning);
  FName.read(DataSize, SizeOf(DWord));
  GetMem(Data,DataSize);
  FName.read(Data^, DataSize);
  FName.Free;
  AppWriteDataToBuffer(Buffer,0,Data^,DataSize);
  FreeMem(Data,DataSize);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyWAVToBuffer('1.wav',SecondarySoundBuffer[0]);
  CopyWAVToBuffer('flip.wav',SecondarySoundBuffer[1]);
  if SecondarySoundBuffer[0].Play(0,0,0) <> DS_OK then
    ShowMessage('Can''t play the Sound');
  if SecondarySoundBuffer[1].Play(0,0,0) <> DS_OK then
    ShowMessage('Can''t play the Sound');
end;

end.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay