проблема с выводом звука определенной частоты в короткие промежутки времени.

[JekaDefer]

Если не сложно может кто нибудь код функции дать подобной этой:

procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel);
{writes tone to memory and plays it}
var
WaveFormatEx: TWaveFormatEx;
MS: TMemoryStream;
i, TempInt, DataCount, RiffCount: integer;
SoundValue: byte;
w: double; // omega ( 2 * pi * frequency)
const
Mono: Word = $0001;
SampleRate: Integer = 11025; // 8000, 11025, 22050, or 44100
RiffId: string = 'RIFF';
WaveId: string = 'WAVE';
FmtId: string = 'fmt ';
DataId: string = 'data';
begin
if Frequency > (0.6 * SampleRate) then
begin
   ShowMessage(Format('Sample rate of %d is too Low to play a tone of %dHz',
     [SampleRate, Frequency]));
   Exit;
end;
with WaveFormatEx do
begin
   wFormatTag := WAVE_FORMAT_PCM;
   nChannels := Mono;
   nSamplesPerSec := SampleRate;
   wBitsPerSample := $0008;
   nBlockAlign := (nChannels * wBitsPerSample) div 8;
   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   cbSize := 0;
end;
MS := TMemoryStream.Create;
with MS do
begin
   {Calculate length of sound data and of file data}
   DataCount := (Duration * SampleRate) div 1000; // sound data
   RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
     SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
   {write out the wave header}
   Write(RiffId[1], 4); // 'RIFF'
   Write(RiffCount, SizeOf(DWORD)); // file data size
   Write(WaveId[1], Length(WaveId)); // 'WAVE'
   Write(FmtId[1], Length(FmtId)); // 'fmt '
   TempInt := SizeOf(TWaveFormatEx);
   Write(TempInt, SizeOf(DWORD)); // TWaveFormat data size
   Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // WaveFormatEx record
   Write(DataId[1], Length(DataId)); // 'data'
   Write(DataCount, SizeOf(DWORD)); // sound data size
   {calculate and write out the tone signal} // now the data values
   w := 2 * Pi * Frequency; // omega
   for i := 0 to DataCount - 1 do
   begin
     SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate)); // wt = w * i / SampleRate
     Write(SoundValue, SizeOf(Byte));
   end;
   {now play the sound}
   sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC);
   MS.Free;
end;
end;

но с использованием WaveOut..

[s-andriano]

у тебя дина буфера 44101 отсчет, это примерно 1 секунда.
Первые 30 мс (nSamples отсчетов) идет синусоида. Остается 970 мс.
Если нужна 30 мс пауза - эти nSamples отсчетов заполняешь нулями.
Если нужно, чтобы следующие 60 мс был звук - следующие nSamples*2 отсчетов - опять синусоида. И все это в одном и том же буфере.
Нужно будет более 1 сек - остаток во второй буфер. И т.д.

Если не сложно может кто нибудь код функции дать подобной этой:

Это неправильная функция - она формирует звуковой фрагмент ограниченной длительности, а тебе нужно неограниченной. По крайней мере, все то время, пока тебе нужно выдерживать точные временные интервалы, у тебя должен быть непрерывный поток звуковых буферов, не прерывающийся ни на одну мс. Т.е. проигрывается первый буфер, готовится второй. Как только первый проигран, второй уже должен быть наготове. И за время проигрывания второго готовится первый - и так по кругу.

[JekaDefer]

ок а почему тот код то не работает? почему не пикает 1 раз?

[JekaDefer]

Мне нужен как раз "пик" с определенной длительностью, но очень точный.
С длительностью разобрался.. блин вроде просто так все (dwBufferLength := sizeof(second) а вот почему не могу сделать чтоб 1 раз пикнуло только

[JekaDefer]

Подскажите почему не проигрывает 1 раз?

procedure WBeep(Freq, Time: Integer);
const
  sps	= 44100;	// samples per second (Hz)
var
  nSamples: Integer;
  angle, delta: double;

  i: integer;

  Sample: array[0..sps] of integer;	// full second
  wout: hWaveOut;
  wfx : TWAVEFORMATEX;
  hdr: WAVEHDR;
  hEvent : THandle;
Begin
  //------------------Заполнение сэмплов
  nSamples := sps * time div 1000;	// Длинна сигнала в сэмплах
  angle := 0;
  delta := (freq / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    Sample[i] := round(sin(angle) * 32767);
    angle := angle + delta;
  end;
  //-----------------ТТХ TWAVEFORMATEX
  With wfx do
  Begin
    wFormatTag := WAVE_FORMAT_PCM;                    // используется PCM формат
    nChannels := 1;                                   // Моно
    nSamplesPerSec := sps;                            // частота дискретизации
    wBitsPerSample := 16;                             // выборка 16 бит
    nBlockAlign := wBitsPerSample div 8 * nChannels;  // число байт в выбоке
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;  // число байт в секундном интервале
    cbSize := 0;     // не используется
  End;
  //------------------ Открытие устройства
  hEvent := CreateEvent(nil,false,false,nil);
  if WaveOutOpen(@wout,0,@wfx,hEvent,0,CALLBACK_EVENT) <> MMSYSERR_NOERROR then
  begin
    CloseHandle(hEvent);
    Exit;
  end;
  //-------------------Заполнение буфера и проигрывание
  fillChar(hdr, sizeof(hdr), #0);
  hdr.lpData := @Sample;
  hdr.dwBufferLength := sizeof(Sample);

  waveOutPrepareHeader(wout, @hdr, sizeof(TWAVEHDR));
  WaveOutWrite(wout, @hdr, sizeof(hdr));
  WaitForSingleObject(hEvent, INFINITE);
  //--------------------Освобождение
  waveOutReset(wout);
  waveOutUnprepareHeader(wout, @hdr, sizeof(TWAVEHDR));
  VirtualFree(@Sample,0,MEM_RELEASE);
  WaveOutClose(wout);
  CloseHandle(hEvent);
End;

Всё, понял почему, устройство закрывается раньше чем начинает играть, исправил внесением паузы(без пауз по ходу никак), со всем разобрался) всем спасибо!

[JekaDefer]

Ребят помогите еще раз.. как в этой функции заполнить сэмплы чтоб получился прямоугольный сигнал с f=1000?:

procedure WBeep(Freq, Time: Integer);
const
  sps	= 44100;	// samples per second (Hz)
var
  Frq_Base, Time_memo, Time_now, dif: Int64;

  nSamples: Integer;
  angle, delta: double;

  i: integer;

  Sample: array[0..sps] of integer;	// full second
  wout: hWaveOut;
  wfx : TWAVEFORMATEX;
  hdr: WAVEHDR;
  hEvent : THandle;
Begin
  //------------------Заполнение сэмплов
  nSamples := sps * time div 1000;	// Длинна сигнала в сэмплах
  angle := 0;
  delta := (freq / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    Sample[i] := round(sin(angle) * 32767);
    angle := angle + delta;
  end;
  //-----------------ТТХ TWAVEFORMATEX
  With wfx do
  Begin
    wFormatTag := WAVE_FORMAT_PCM;                    // используется PCM формат
    nChannels := 1;                                   // Моно
    nSamplesPerSec := sps;                            // частота дискретизации
    wBitsPerSample := 16;                             // выборка 16 бит
    nBlockAlign := wBitsPerSample div 8 * nChannels;  // число байт в выбоке
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;  // число байт в секундном интервале
    cbSize := 0;     // не используется
  End;
  //------------------ Открытие устройства
  hEvent := CreateEvent(nil,false,false,nil);
  if WaveOutOpen(@wout,0,@wfx,hEvent,0,CALLBACK_EVENT) <> MMSYSERR_NOERROR then
  begin
    CloseHandle(hEvent);
    Exit;
  end;
  //-------------------Заполнение буфера и проигрывание
  fillChar(hdr, sizeof(hdr), #0);
  hdr.lpData := @Sample;
  hdr.dwBufferLength := sizeof(Sample);

  waveOutPrepareHeader(wout, @hdr, sizeof(TWAVEHDR));
  WaveOutWrite(wout, @hdr, sizeof(hdr));
  WaitForSingleObject(hEvent, INFINITE);

  if QueryPerformanceFrequency(Frq_Base) then // Частота ПК
  begin
    QueryPerformanceCounter(Time_memo);        // начальное значение
    repeat
      QueryPerformanceCounter(Time_now);
      dif := ((Time_now - Time_memo) * 1000000) div Frq_Base;
    until dif > Time*1000;
  end;
  //--------------------Освобождение
  waveOutReset(wout);
  waveOutUnprepareHeader(wout, @hdr, sizeof(TWAVEHDR));
  VirtualFree(@Sample,0,MEM_RELEASE);
  WaveOutClose(wout);
  CloseHandle(hEvent);
End;

[s-andriano]

Ну так и заполняешь: одна половина периода плюс амплитуда, вторая - минус амплитуда.

[JekaDefer]

Это я знаю а как это на сэмплах отразить?

//------------------Заполнение сэмплов
  nSamples := sps * time div 1000;	// Длинна сигнала в сэмплах
  angle := 0;
  delta := (freq / sps*2) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    Sample[i] := round(sin(angle) * 32767);
    angle := angle + delta;
  end;

[s-andriano]

  for i := 0 to nSamples div 2 - 1 do begin
    Sample[i] := 32767;
  end;
  for i := nSamples div 2 to nSamples - 1 do begin
    Sample[i] := -32767;
  end;

[JekaDefer]

Сообщение от s-andriano

  for i := 0 to nSamples div 2 - 1 do begin
    Sample[i] := 32767;
  end;
  for i := nSamples div 2 to nSamples - 1 do begin
    Sample[i] := -32767;
  end;

Не работает чтото..