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

[veniside]

ну вот код, который пищит 1000Hz в течении 30 мс, а потом 970 мс молчит, и так 3 раза

program
  GenWave;

{$APPTYPE CONSOLE}

uses
  SysUtils, Math,
  MMSystem;

const
  sps	= 44100;	// samples per second (Hz)
  freq	= 1000;	 	// signal frequency (Hz)
  time	= 30;		// time of signal (ms)


type
  int16 = smallint;

var
  second: array[0..sps] of int16;	// full second

// --  --
procedure prepareSine();
var
  i, nSamples: Integer;
  angle, delta: double;
begin
  nSamples := sps * time div 1000;	// signal length in samples
  //
  angle := 0;
  delta := (freq / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    second[i] := round(sin(angle) * 32767);
    angle := angle + delta;
  end;
end;

// -- main --

var
  i: integer;
  wout: hWaveOut = 0;
  fmt: tWAVEFORMATEX;
  hdr: array[0..2] of WAVEHDR;
begin
  prepareSine();
  //
  fmt.wFormatTag := 1; // PCM
  fmt.nChannels := 1; // mono
  fmt.nSamplesPerSec := sps;
  fmt.nAvgBytesPerSec := sps shl 1;	// * 2
  fmt.nBlockAlign := 2;
  fmt.wBitsPerSample := 16;
  fmt.cbSize := 0;
  //
  WaveOutOpen(@wout, cardinal(-1), @fmt, 0, 0, 0);
  if (0 <> wout) then begin
    //
    for i := 0 to 2 do begin
      //
      fillChar(hdr[i], sizeof(hdr), #0);
      hdr[i].lpData := @second;
      hdr[i].dwBufferLength := sizeof(second);
      //
      waveOutPrepareHeader(wout, @hdr[i], sizeof(hdr[i]));
      WaveOutWrite(wout, @hdr[i], sizeof(hdr[i]));
    end;
    //
    Sleep(3001);	// sleep for 3 seconds
    //
    WaveOutClose(wout);
  end;
end.

важно понять, что мы сами управляем, где тишина, где сигнал, формируя данные в буферах. Как только один буфер отработал, мы можем его использовать повторно. Но это уже будет слишком много для маленького простого примера.

[JekaDefer]

На Delphi 7 выдает ошибку сразу после проигрывания 3 раз..(так и не понял почему, наверно с блоками в памяти что то не так) но смысл я понял. Кстати процедура Sleep дает очень большую погрешность. С длительность самого сигнала разобрался, только вот теперь не соображу как с длительностью между сигналами разобраться, откуда пауза в 970 Мсек? и что то мне Sleep этот... можно как нибудь без него? (Если например надо жать на кнопку быстро несколько раз и чтоб с каждым нажатием пикало 30 Мсек и не было после паузы) Мне уже за использование доп пауз выговор сделали:-)

[veniside]

> На Delphi 7 выдает ошибку

хм, странно. Но это в любом случае просто шаблон, чтобы показать принцип, а не законченная программа.


> откуда пауза в 970 Мсек?

1000 - 30 = 970

у нас 30 мс сигнала, остальное тишина. Буфер second не просто так назван ) Да, если поиграть с константами freq и time можно получить "больше" звука и на другой частоте.


> процедура Sleep дает очень большую погрешность
> и что то мне Sleep этот... можно как нибудь без него?

Sleep в данном случае исключительно для того, чтобы консольное приложение сразу не закрылось. Его можно поменять на Read() или что угодно другое. К генерации звука это никакого отношения не имеет.

[JekaDefer]

Сообщение от veniside

>

пасиб буду тестировать. Осталось только найти простенький но ровный шаблон..:-) А, да мож я туплю но что то не пойму как всего один раз заставить прозвучать твой код)))

[veniside]

for i := 0 to 2 do begin

заменить на

for i := 0 to 0 do begin

[raxp]

Мне уже за использование доп пауз выговор сделали

какова цель столь строгого придерживания формируемых выдержек? Для учебного задания маловероятно.

[JekaDefer]

Сообщение от veniside

for i := 0 to 2 do begin

заменить на

for i := 0 to 0 do begin

Я пробовал именно так и вообще без цикла до того как спросил, не пищит совсем.. Когда For i:=0 to 1 и более пищит но от 2 раз... хрень какая то...

[JekaDefer]

Сообщение от raxp

какова цель столь строгого придерживания формируемых выдержек? Для учебного задания маловероятно.

Выговор в смысле здесь на сайте в этой же ветке ранее:-)

[s-andriano]

Сообщение от JekaDefer

Кстати процедура Sleep дает очень большую погрешность. С длительность самого сигнала разобрался, только вот теперь не соображу как с длительностью между сигналами разобраться, откуда пауза в 970 Мсек? и что то мне Sleep этот... можно как нибудь без него? (Если например надо жать на кнопку быстро несколько раз и чтоб с каждым нажатием пикало 30 Мсек и не было после паузы) Мне уже за использование доп пауз выговор сделали:-)

Sleep не нужна вообще. Здесь она исключительно для того, чтобы работал упрощенный пример.
Реально нужно создать два буфера, один будет проигрываться, а другой в это время заполняться новыми данными. И так по кругу до бесконечности. Код, заполняющий буфер, нужно запускать в отдельном потоке по event, сообщающем об исчерпании буфера (его генерит звуковая карта).

Длительность пауз задается ТОЧНО ТАК ЖЕ, как и длительность звука.

Если Вам нужно, чтобы звук зависел от нажатия на клавиши, при обработке клавиатуры просто устанавливаете флажки, которые затем используются кодом, заполняющим буфер.

[JekaDefer]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MMSystem, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
  sps	= 44100;	// samples per second (Hz)
  freq	= 1000;	 	// signal frequency (Hz)
  time	= 30;		// time of signal (ms)
var
  Form1: TForm1;
  second: array[0..sps] of integer;	// full second
implementation

{$R *.dfm}
procedure prepareSine;
var
  i, nSamples: Integer;
  angle, delta: double;
begin
  nSamples := sps * time div 1000;	// signal length in samples
  //
  angle := 0;
  delta := (freq / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    second[i] := round(sin(angle) * 32767);
    angle := angle + delta;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  wout: hWaveOut;
  wfx : TWAVEFORMATEX;
  hdr: WAVEHDR;
  hEvent : THandle;
begin
  prepareSine;

  With wfx do
  Begin
    wFormatTag := WAVE_FORMAT_PCM;                  
    nChannels := 1;                               
    nSamplesPerSec := sps;                           
    wBitsPerSample := 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 := @second;
    hdr.dwBufferLength := sizeof(second);

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

  waveOutReset(wout);
  waveOutUnprepareHeader(wout, @hdr, sizeof(TWAVEHDR));
  VirtualFree(@second,0,MEM_RELEASE);
  WaveOutClose(wout);
  CloseHandle(hEvent);
end;

end.

Ребят что здесь не правильно? не хочет пищать и все:-( Veniside, я не совсем понял про то как в буфер запихивается пауза в 970 МСек.. я понял что 1000-30=970 но где это указанно не соображу, по идее там где заполняется массив Second, но как мне тогда установить паузу в 30 Мсек? или вообще без паузы пикнуть.. Шел третий день - не могу "пикнуть"))))