Autor Beitrag
benorth
Hält's aus hier
Beiträge: 6



BeitragVerfasst: So 23.03.03 16:10 
Hallo,

wie ist es in Delphi möglich verschiedene Töne (nur einfache Frequenzen) über die Soundkarte auszugeben und diese als Wave zu speichern?

Der Gedanke ist der, verschiedene Töne mit unterschiedlicher Länge abzuspielen.

Weiß jemand vielleicht eine Lösung oder hat einen Tipp?
Andreas Pfau
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 997



BeitragVerfasst: So 23.03.03 21:10 
Also, erstmal empfehle ich www.wotsit.org/. Da findest du die Deklaration vieler Dateiformate, auch Wave (.wav).

Dann: Wave-Blöcke (PCM) erzeugen. Dazu ein paar Prozeduren:
ausblenden volle Höhe Quelltext
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:
procedure GenerateSinus(Samples: Integer; out Data: Pointer; out Size: Integer);
var
 I: Integer;
begin
 Size := 2 * Samples;
 GetMem(Data, Size);

 For I := 0 To Samples - 1 Do
  PSmallInt(Integer(Data) + I * 2)^ := Round(Sin(I / Samples * 2 * Pi) * $7FFF);
end;

procedure GenerateSquare(Samples: Integer; out Data: Pointer; out Size: Integer);
var
 I, Address: Integer;
begin
 Size := 2 * Samples;
 GetMem(Data, Size);

 For I := 0 To Samples div 2 - 2 Do
  PSmallInt(Integer(Data) + I * 2)^ := $7FFF;
 For I := Samples div 2 - 1 To Samples - 1 Do
  PSmallInt(Integer(Data) + I * 2)^ := -$8000;
end;

procedure GenerateTriangle(Samples: Integer; out Data: Pointer; out Size: Integer);
var
 I, P1, P2: Integer;
begin
 Size := 2 * Samples;
 GetMem(Data, Size);

 P1 := Round(Samples * 0.25);
 P2 := Round(Samples * 0.75);

 For I := 0 To Samples - 1 Do
  If I < P1 Then
   PSmallInt(Integer(Data) + I * 2)^ := Round($FFFF * +2 * I / Samples)
  Else If I > P2 Then
   PSmallInt(Integer(Data) + I * 2)^ := Round($FFFF * +2 * (I / Samples - 1))
  Else
   PSmallInt(Integer(Data) + I * 2)^ := Round($FFFE * -2 * (I / Samples - 0.5));
end;

procedure GenerateNeedle(Samples: Integer; out Data: Pointer; out Size: Integer);
var
 I: Integer;
 V: Single;
begin
 Size := 2 * Samples;
 GetMem(Data, Size);

 V := Ln(1 / $7FFF) * 2;

 For I := 0 To Samples div 2 - 2 Do
  PSmallInt(Integer(Data) + I * 2)^ := Round(Exp((I / Samples - 0.0) * V) * $7FFF);
 For I := Samples div 2 - 1 To Samples - 1 Do
//  PSmallInt(Integer(Data) + I * 2)^ := EnsureRange(Round(Exp((I / Samples - 1/2) * V) * -$7FFF), -$8000, $7FFF);
  PSmallInt(Integer(Data) + I * 2)^ := Round(Exp((I / Samples - 1/2) * V) * -$7FFF);
end;


Di gisbt an: Wieviele samples, Dann einen Pointer für Daten und eine Variable für die Größe. Jede Prozedur erzeugt ein Signal (Sinus, Rechteck, Drieck, Nadelimpuls) mit maximaler Amplitude bei 44,1kHz und 16Bit, PCM-Format (ich arbeite grade noch an Sägezahn).

So wird's abgespielt:
ausblenden volle Höhe Quelltext
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:
uses MmSystem;

{...}

function _OpenMapper: HWaveOut;
var
 Fmt: TWaveFormatEx;
begin
 Fmt.cbSize          := SizeOf(Fmt);
 Fmt.wFormatTag      := Wave_Format_Pcm;
 Fmt.nChannels       := 1;
 Fmt.nSamplesPerSec  := 44100;
 Fmt.nAvgBytesPerSec := 44100 * 2 * 1;
 Fmt.nBlockAlign     := 2 * 1;
 Fmt.wBitsPerSample  := 16;
 If WaveOutOpen(@Result, Wave_Mapper, @Fmt, 0, 0, 0) <> MmSysErr_NoError Then
  ShowMessage('Error Open');
end;

function _PlayMapper(Mapper: HWaveOut; Data: Pointer; Size: Integer): TWaveHdr;
begin
 Result.lpData          := PChar(Data);
 Result.dwBufferLength  := Size;
 Result.dwBytesRecorded := 0;
 Result.dwUser          := 0;
 Result.dwFlags         := WHdr_BeginLoop Or WHdr_EndLoop;
 Result.dwLoops         := $FFFFFFFF; // ~ nahezu endlos
 Result.lpNext          := 0;
 Result.reserved        := 0;
 If WaveOutPrepareHeader(Mapper, @Result, SizeOf(Result)) <> MmSysErr_NoError Then
  ShowMessage('Error Prepare');
 If WaveOutWrite(Mapper, @Result, SizeOf(Result)) <> MmSysErr_NoError Then
  ShowMessage('Error Write');
end;

procedure _StopMapper(Mapper: HWaveOut; Header: TWaveHdr);
begin
 WaveOutReset(Mapper);
 WaveOutUnprepareHeader(Mapper, @Header, SizeOf(Header));
end;

procedure _CloseMapper(Mapper: HWaveOut);
begin
 WaveOutClose(Mapper);
end;

{...}

var
 Size: Integer;
 Data: Pointer;
 M: HWaveOut;
 H: TWaveHdr;
begin
 GenerateSinus(44100 div 1000, Data, Size); // 1kHz
 Application.ProcessMessages;
 M := _OpenMapper;
 H := _PlayMapper(M, Data, Size);
 Sleep(1000); // 1 Sekunde
 _StopMapper(M, H);
 _CloseMapper(M);
 FreeMem(Data);


Ansosten: ausprobieren, ausprobieren, ausprobieren!!! Es gibt viel zu Entdecken. Außerdem sollte gesagt sein, dass ich nicht sicher bin, ob alle Methoden so auch funktionieren. Müsste aber.

_________________
Life is a bad adventure, but the graphic is really good!
mimi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 3458

Ubuntu, Win XP
Lazarus
BeitragVerfasst: Mo 24.03.03 00:07 
bei www.torry.net gibt es den TonGen, der macht auch das was du willst;)

_________________
MFG
Michael Springwald, "kann kein englisch...."