unit Unit1;
interface
uses
[...], MMSystem;
type
TForm1 =
class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
public
wData:
packed array of SmallInt;
wDataToSend: WAVEHDR_TAG;
wFormat: TWAVEFORMATEX;
wo: HWAVEOUT;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
res: MMResult;
i: Integer;
begin
SetLength(wData, IrgendeineLaenge);
// in wData kommen die zu spielenden Samples
with wFormat
do
begin
// Das wird ein PCM-Wave (RAW), Mono, 44.1 kHz, 16 Bit
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 44100;
nAvgBytesPerSec := 2*nSamplesPerSec;
wBitsPerSample := 16;
nBlockAlign := (nChannels*wBitsPerSample)
div 8;
cbSize := SizeOf(TWAVEFORMATEX);
end;
res := waveOutOpen(@wo, WAVE_MAPPER, @wFormat, 0, 0, 0);
case res
of
MMSYSERR_ALLOCATED : ShowMessage('
Specified resource is already allocated.');
MMSYSERR_BADDEVICEID: ShowMessage('
Specified device identifier is out of range.');
MMSYSERR_NODRIVER : ShowMessage('
No device driver is present.');
MMSYSERR_NOMEM : ShowMessage('
Unable to allocate or lock memory.');
WAVERR_BADFORMAT : ShowMessage('
Attempted to open with an unsupported waveform-audio format.');
WAVERR_SYNC : ShowMessage('
The device is synchronous but waveOutOpen was called without using the WAVE_ALLOWSYNC flag.');
end;
with wDataToSend
do
begin
lpData := @wData[0];
dwBufferLength := Length(wData)*SizeOf(SmallInt);
dwFlags := WHDR_BEGINLOOP
or WHDR_ENDLOOP;
dwLoops := 1000;
end;
res := waveOutPrepareHeader(wo, @wDataToSend, SizeOf(WAVEHDR_TAG));
case res
of
MMSYSERR_INVALHANDLE: ShowMessage('
Specified device handle is invalid.');
MMSYSERR_NODRIVER : ShowMessage('
No device driver is present.');
MMSYSERR_NOMEM : ShowMessage('
Could not allocate Memory.');
end;
// Einfach mal Rauschen reinschreiben
for i := 0
to Length(wData)-1
do
begin
wData[i] := random(High(SmallInt)*2) - High(SmallInt);
end;
waveOutWrite(wo, @wDataToSend, SizeOf(WAVEHDR));
waveOutRestart(wo);
// und abspielen
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
waveOutClose(wo);
// Wichtig! Am Ende das Device schließen.
end;