uses mmsystem;
var
SamplesPerSec: integer = 22050;
wavefmt: string = 'WAVEfmt ';
riff: string = 'RIFF';
data: string = 'data';
procedure DTMFSound(Freq1, Freq2, Dauer: integer);
var
b: byte;
f1, f2: double;
wfe: tWAVEFORMATEX;
i, count, grs: cardinal;
soc, lwf, sowfe, ldta: integer;
begin
wfe.wFormatTag := WAVE_FORMAT_PCM;
wfe.nChannels := 1;
wfe.nSamplesPerSec := SamplesPerSec;
wfe.wBitsPerSample := 8;
wfe.nBlockAlign := (wfe.nChannels * wfe.wBitsPerSample) shr 3;
wfe.nAvgBytesPerSec := SamplesPerSec * wfe.nBlockAlign;
soc := sizeof(cardinal);
lwf := length(wavefmt);
sowfe := sizeof(wfe);
ldta := length(data);
count := (Dauer * SamplesPerSec) div 1000;
grs := soc * 2 + lwf + sowfe + ldta + count;
f1 := 2 * pi * Freq1 / SamplesPerSec;
f2 := 2 * pi * Freq2 / SamplesPerSec;
with TMemoryStream.Create do begin
size := length(riff) + soc + grs;
write(riff[1], length(riff));
write(grs, soc);
write(wavefmt[1], lwf);
write(sowfe, soc);
write(wfe, sowfe);
write(data[1], ldta);
write(count, soc);
for i := 0 to pred(count) do begin
b := 128 + trunc(63 * sin(i * f1) + 63 * sin(i * f2));
write(b, 1);
end;
playsound(Memory, 0, SND_MEMORY or SND_SYNC);
free;
end;
end;
function DTMF(s: string): boolean;
var i, d: integer;
function ok: boolean;
var x: integer;
begin
result := false;
for x := 1 to length(s) do
if not (s[x] in ['0'..'9', '*', '#', ',', ' ']) then exit;
result := true;
end;
begin
screen.cursor := crHourGlass;
result := false;
if ok then begin
d := 100;
for i := 1 to length(s) do begin
case s[i] of
'*': DTMFSound(941, 1209, d);
'#': DTMFSound(941, 1477, d);
'0': DTMFSound(941, 1336, d);
'1': DTMFSound(697, 1209, d);
'2': DTMFSound(697, 1336, d);
'3': DTMFSound(697, 1477, d);
'4': DTMFSound(770, 1209, d);
'5': DTMFSound(770, 1336, d);
'6': DTMFSound(770, 1477, d);
'7': DTMFSound(852, 1209, d);
'8': DTMFSound(852, 1336, d);
'9': DTMFSound(852, 1477, d);
end;
sleep(d);
end;
result := true;
end;
screen.cursor := crDefault;
end;
// Beispielaufruf
procedure TForm1.Button2Click(Sender: TObject);
begin
if not DTMF('0185 273649') then showmessage('FEHLER');
end;