1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

procedure TMain.Button3Click(Sender: TObject);
const
 Frequency = 600.0;
var
 Id: HWaveOut;
 Fmt: TWaveFormatEx;
 Hdr: Array[0..3] Of TWaveHdr;
 Buf: Array[0..3] Of Pointer;
 Siz, Sam, Byt, Sps: Integer;
 I, J: Integer;
begin
 Sps := 96000;
 Byt := 2;
 Sam := Sps div 2;

 Fmt.cbSize          := SizeOf(Fmt);
 Fmt.wFormatTag      := Wave_Format_Pcm;
 Fmt.nChannels       := 1;
 Fmt.nSamplesPerSec  := Sps;
 Fmt.nAvgBytesPerSec := Sps * Byt * 1;
 Fmt.nBlockAlign     := Byt * 1;
 Fmt.wBitsPerSample  := Byt * 8;

 If WaveOutOpen(@Id, Wave_Mapper, @Fmt, 0, 0, 0) = MmSysErr_NoError Then begin
  Siz := SizeOf(SmallInt) * Sam;

  For I := 0 To 3 Do begin
   GetMem(Buf[I], Siz);
   ZeroMemory(@Hdr[I], SizeOf(Hdr[I]));
  end;

  For I := 0 To Sam - 1 Do
   PSmallInt(Integer(Buf[0]) + I * SizeOf(SmallInt))^ := Round(Sin((I / (Sam / 100)) * 2 * Pi) * $7fff);
  For I := 0 To Sam - 1 Do
   PSmallInt(Integer(Buf[1]) + I * SizeOf(SmallInt))^ := IfThen(Sin((I / (Sam / 100)) * 2 * Pi) > 0, $7fff, -$7fff);
  For I := 0 To Sam - 1 Do
   PSmallInt(Integer(Buf[2]) + I * SizeOf(SmallInt))^ := Round(Sin((I / (Sam / 100)) * 2 * Pi) * $7fff);
  For I := 0 To Sam - 1 Do
   PSmallInt(Integer(Buf[3]) + I * SizeOf(SmallInt))^ := IfThen(Sin((I / (Sam / 100)) * 2 * Pi) > 0, $7fff, -$7fff);


  For I := 0 To 3 Do begin
   Hdr[I].lpData := PChar(Buf[I]);
   Hdr[I].dwBufferLength := Siz;
  end;
  Hdr[0].dwLoops := $FFFFFFFF;
  Hdr[0].dwFlags := Whdr_BeginLoop;
  Hdr[3].dwFlags := Whdr_EndLoop;

  For I := 0 To 3 Do
   WaveOutPrepareHeader(Id, @Hdr[I], SizeOf(Hdr[I]));
  For I := 0 To 3 Do
   WaveOutWrite(Id, @Hdr[I], SizeOf(Hdr[I]));

  Sleep(3000);
  WaveOutBreakLoop(Id);
  WaveOutReset(Id);
  For I := 0 To 3 Do
   WaveOutUnprepareHeader(Id, @Hdr[I], SizeOf(Hdr[I]));
  WaveOutClose(Id);
  For I := 0 To 3 Do
   FreeMem(Buf[I]);
 end Else ShowMessage('Das Gerät konnte nicht geöffnet werden');
end;