Kniga-Online.club
» » » » Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Читать бесплатно Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001. Жанр: Программирование издательство неизвестно, год 2004. Так же читаем полные версии (весь текст) онлайн без регистрации и SMS на сайте kniga-online.club или прочесть краткое содержание, предисловие (аннотацию), описание и ознакомиться с отзывами (комментариями) о произведении.
Перейти на страницу:

  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:[email protected];

 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.

Пример 2

Представляю вашему вниманию очередной пример работы с DirectSound на Delphi. В этом примере показан принцип работы с 3D буфером. Итак, процедуры AppCreateWritePrimaryBuffer, AppWriteDataToBuffer, CopyWAVToBuffer я оставил без изменения (см. письма с до этого). Процедура AppCreateWriteSecondary3DBuffer является полным аналогом процедуры AppCreateWriteSecondaryBuffer, за исключением флага DSBCAPS_CTRL3D, который указывает на то, что со статическим вторичным буфером будет связан еще один буфер – SecondarySound3DBuffer. Чтобы его инициализировать, а также установить некоторые начальные значения (положение в пространстве, скорость и .т.д.) вызывается процедура AppSetSecondary3DBuffer, в качестве параметров которой передаются сам SecondarySoundBuffer и связанный с ним SecondarySound3DBuffer. В этой процедуре SecondarySound3DBuffer инициализируется с помощью метода QueryInterface c соответствующим флагом. Кроме того, здесь же устанавливается положение источника звука в пространстве: SetPosition(Pos,1{X},1{Y},0{Z}).

Таким образом в начальный момент времени источник находится на высоте 1 м (ось Y направлена вертикально вверх, а ось Z – «в экран»). Если смотреть сверху :

                  ↑ Z

                  |

    А             |

                  |

                  O----------------> X

Точка O (фактически вы) имеет координаты (0,0), источник звука А(-25,1). Разумеется понятие «метр» весьма условно.

При нажатии на кнопку в буфер SecondarySoundBuffer загружается звук 'xhe4.wav'. Это звук работающего винта вертолета, его длина (звука) ровно 3.99 с (а размер буфера ровно 4 с). Далее происходит микширование из вторичного буфера в первичный с флагом DSBPLAY_LOOPING, что позволяет сделать многократно повторяющийся звук; время в 0.01 с ухом практически не улавливается и получается непрерывный звук летящего вертолета. После этого запускется таймер (поле INTERVAL в Инспекторе Оъектов установлено в 1). Разумеется, Вам совсем необязательно делать именно так, это просто пример. В процедуре Timer1Timer просто меняется координата X с шагом 0.1.

В итоге получаем летящий вертолет слева направо. Заодно можете проверить, правильно ли у вас расположены колонки.

PS. Если есть вопросы, постараюсь на них ответить.

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);

 procedure Timer1Timer(Sender: TObject);

private

 DirectSound: IDirectSound;

 DirectSoundBuffer: IDirectSoundBuffer;

 SecondarySoundBuffer: IDirectSoundBuffer;

 SecondarySound3DBuffer: IDirectSound3DBuffer;

 procedure AppCreateWritePrimaryBuffer;

 procedure AppCreateWriteSecondary3DBuffer(var Buffer: IDirectSoundBuffer; SamplesPerSec: Integer; Bits: Word; isStereo: Boolean; Time: Integer);

 procedure AppSetSecondary3DBuffer(var Buffer: IDirectSoundBuffer; var _3DBuffer: IDirectSound3DBuffer);

 procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer; OffSet: DWord; var SoundData; SoundBytes: DWord);

 procedure CopyWAVToBuffer(Name: PChar; var Buffer: IDirectSoundBuffer);

 { Private declarations }

public

  { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var Result : HResult;

begin

 if DirectSoundCreate(nil, DirectSound, nil) <> DS_OK then Raise Exception.Create('Failed to create IDirectSound object');

 AppCreateWritePrimaryBuffer;

 AppCreateWriteSecondary3DBuffer(SecondarySoundBuffer, 22050, 8, False, 4);

 AppSetSecondary3DBuffer(SecondarySoundBuffer, SecondarySound3DBuffer);Timer1.Enabled:=False;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var i: ShortInt;

begin

 if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;

 if Assigned(SecondarySound3DBuffer) then SecondarySound3DBuffer.Release;

 if Assigned(SecondarySoundBuffer) then SecondarySoundBuffer.Release;

 if Assigned(DirectSound) then DirectSound.Release;

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 Cooperative 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 ');

Перейти на страницу:

Валентин Озеров читать все книги автора по порядку

Валентин Озеров - все книги автора в одном месте читать по порядку полные версии на сайте онлайн библиотеки kniga-online.club.


Советы по Delphi. Версия 1.4.3 от 1.1.2001 отзывы

Отзывы читателей о книге Советы по Delphi. Версия 1.4.3 от 1.1.2001, автор: Валентин Озеров. Читайте комментарии и мнения людей о произведении.


Уважаемые читатели и просто посетители нашей библиотеки! Просим Вас придерживаться определенных правил при комментировании литературных произведений.

  • 1. Просьба отказаться от дискриминационных высказываний. Мы защищаем право наших читателей свободно выражать свою точку зрения. Вместе с тем мы не терпим агрессии. На сайте запрещено оставлять комментарий, который содержит унизительные высказывания или призывы к насилию по отношению к отдельным лицам или группам людей на основании их расы, этнического происхождения, вероисповедания, недееспособности, пола, возраста, статуса ветерана, касты или сексуальной ориентации.
  • 2. Просьба отказаться от оскорблений, угроз и запугиваний.
  • 3. Просьба отказаться от нецензурной лексики.
  • 4. Просьба вести себя максимально корректно как по отношению к авторам, так и по отношению к другим читателям и их комментариям.

Надеемся на Ваше понимание и благоразумие. С уважением, администратор kniga-online.


Прокомментировать
Подтвердите что вы не робот:*
Подтвердите что вы не робот:*