500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
Как расписать стеклянную посуду.
Как программно включить или выключить NumLock?

var
abKeyState: array [0..255] of byte;
begin
GetKeyboardState( Addr( abKeyState[ 0 ] ) );
abKeyState[ VK_NUMLOCK ] := abKeyState[ VK_NUMLOCK ] or $01;
SetKeyboardState( Addr( abKeyState[ 0 ] ) );
Как использовать в своей программе API DirectSound и DirectSound3D?

Пример 1:

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

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);
private
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);
{ Private declarations }
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.

Пример 2:

Представляю вашему вниманию очередной пример работы с DirectSound на Delphi.
В этом примере показан принцип работы с 3D буфером. Итак, процедуры
AppCreateWritePrimaryBuffer, AppWriteDataToBuffer, CopyWAVToBuffer я оставил
без изменения (см. письма с до этого). Процедура
AppCreateWriteSecondary3DBuffer является полным аналогом процедуры
AppCreateWriteSecondaryBuffer, за исключением флага DSBCAPS_CTRL3D, который
указывает на то, что со статическим вторичным буфером будет связан еще один
буфер - SecondarySound3DBuffer. Чтобы его инициализировать, а также установить
некоторые начальные значения (положение в пространстве, скорость и .т.д.)
вызывается процедура AppSetSecondary3DBuffer, в качестве параметров которой
передаются сам SecondarySoundBuffer и связанный с ним SecondarySound3DBuffer.
В этой процедуре SecondarySound3DBuffer инициализируется с помощью метода
QueryInterface c соответствующим флагом. Кроме того, здесь же устанавливается
положение источника звука в пространстве: SetPosition(Pos,1,1,0).
X,Y,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 ');
if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK
then Raise Exception.Create('Unable to set Cooperative Level');
end;

procedure TForm1.AppCreateWriteSecondary3DBuffer;
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 or DSBCAPS_CTRL3D;
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.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.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;

var Pos : Single = -25;

procedure TForm1.AppSetSecondary3DBuffer;
begin
if Buffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then
Raise Exception.Create('Failed to create IDirectSound3D object');
if _3DBuffer.SetPosition(Pos,1,1,0) <> DS_OK then
Raise Exception.Create('Failed to set IDirectSound3D Position');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CopyWAVToBuffer('xhe4.wav',SecondarySoundBuffer);

if SecondarySoundBuffer.Play(0,0,DSBPLAY_LOOPING) <> DS_OK
then ShowMessage('Can''t play the Sound');

Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
SecondarySound3DBuffer.SetPosition(Pos,1,1,0);
Pos:=Pos + 0.1;
end;

end.

Материалы находятся на сайте http://cracklab.narod.ru/faq/

Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz