// Es werden Töne für das Tonwahlverfahren DTMF
// (Dual Tone Multiple Frequency)

// erzeugt.


// Getestet mit D4 unter XP

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;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke