Konstante Töne

[ReDoX]

Hi,
Ich habe ein Problem und zwar erzeuge ich mit dieser procedure.
Das Töne erzeugen klappt auch schon gut aber wenn ich einen durchgehenden tön erzeugen will (TTimer) klappt das nicht so wie ich will. Wenn ich

Delphi-Quellcode:

MakeSound(1200, 100, 127);

das in einen Timer mit dem Interval 1 schreibe gibt es immer pausen zwischen den Tönen wie kann ich das vermeiden?
Mfg MrScholz

[Die Muhkuh]

Hi,

Delphi-Quellcode:

MakeSound(1200, 100, 127);

Das ist auch kein Wunder ;) .

Der zweite Parameter ( 100 ) gibt an, wielange der Ton erzeugt werden soll. In dem Fall 100 Millisekunden.

Wenn du den Ton 1 Minuten lang haben willst, dann musste halt 10000 einsetzen ;)

[ReDoX]

Ja das ist schon klar :stupid: aber ich will den Ton verändern können während der Ton abgespielt wird
deswegen die länge 100
Mfg MrScholz

[dizzy]

Ich hab das mal so gemacht:

Delphi-Quellcode:

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;

Gruss,
Fabian

\\Edit: Zum Verändern den Output mit "waveOutPause(wo);" anhalten, wData neu befüllen, das "waveOutWrite()" erneut ausführen, und mit "waveOutRestart(wo);" weiter wiedergeben. Dabei kann es allerdings, je nach Bufferlänge und Aufwand des Befüllens, auch zu kleinen Aussetzern kommen. Da muss man dann ein wenig rumspielen, oder wie ich, es einfach hin nehmen :D

[ReDoX]

Danke für die Antwort :-D
aber dann muss ich mein ganze programm umstellen ich gucke mal ob ich meinen source so hinbekomme das es funktioniert.
Mfg MrScholz
PS: Wer eine andere idee hat bitte melden