Последние записи

made in programmersforum 7

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

13th
Июн

Проиграть сигнал больше чем 1 сек

Posted by Chas under Delphi

Народ делаю универсальный «Beep» помогите сделать так чтобы эта процедура использовав несколько буферов проигрывала сигнал больше чем 1 сек?

veniside

program

  GenWave;
{$APPTYPE CONSOLE }
uses

  Windows,

  SysUtils, Math, MMSystem;
type

  int 	= integer;

  int16 = smallint;

  bool	= LongBool;
const

  sps	= 44100;

  c_max_buffers	= 3;

  c_buf_size	= sps div 10;	// (100 ms)
var

  freq: int		= 4000;

  timeSignal: int	= 30;

  timePause: int	= 970;
var

  done: bool;

  buffer: array[0..c_max_buffers - 1, 0..c_buf_size - 1] of int16;

  event: tHandle;

  hdr: array[0..c_max_buffers - 1] of WAVEHDR;

  wout: hWaveOut = 0;

  //

  angle, delta: double;

  nSamples: int;

  isSignal: bool = false;
// --  --

procedure prepareSine(index: int);

var

  i: int;

begin

  i := 0;

  repeat

    //

    while ((0 < nSamples) and (i < c_buf_size)) do begin
      //
      if (isSignal) then begin
	//
	buffer[index][i] := round(sin(angle) * 32767);
	angle := angle + delta;
      end
      else
	buffer[index][i] := 0;
      //
      inc(i);
      dec(nSamples);
    end;
    //
    if (0 < nSamples) then
      break;
    //
    isSignal := not isSignal;
    if (isSignal) then begin
      //
      // stat new sine
      angle := 0;
      delta := (freq / sps) * 2 * Pi;
    end;
    //
    if (isSignal) then
      nSamples := sps * timeSignal div 1000
    else
      nSamples := sps * timePause div 1000;
    //
  until (false);
end;

// --  --
function thread_proc(param: Pointer): DWORD; stdcall;
var
  hp: PWaveHdr;
  bc: int;
  justPrepared: int;
begin
  bc := 0;
  while (not done) do begin
    //
    if (WAIT_OBJECT_0 = waitForSingleObject(event, 300)) then begin
      //
      justPrepared := 0;
      repeat
	//
	inc(bc);
	if (bc >= c_max_buffers) then

	  bc := 0;

	//

	prepareSine(bc);

	//

	hp := @hdr[bc];

	if (0 = (WHDR_PREPARED and hp.dwFlags)) then begin

	  //

	  // prepare header

	  hp.lpData := pAnsiChar(@buffer[bc]);

	  hp.dwBufferLength := sizeof(buffer[bc]);

	  waveOutPrepareHeader(wout, hp, sizeof(WAVEHDR));

	  //

	  inc(justPrepared);

	end;

	//

	if (0 <> (WHDR_PREPARED and hp.dwFlags)) then

	  waveOutWrite(wout, hp, sizeof(WAVEHDR))

	else

	  ; // header was not prepared

	//

      until ((0 = justPrepared) or (justPrepared >= c_max_buffers));

    end;

  end;

  //

  result := 0;

end;
// --  --

procedure fail(const msg: string);

begin

  writeln(msg, ' Error code: ', GetLastError());

end;
var

  wasKey: bool;
// --  --

function key(scancode: int): bool;

begin

  result := (0 <> (not int(high(Smallint)) and GetAsyncKeyState(scancode)));

  if (result) then begin

    //

    wasKey := true;

    Sleep(90);	// sleep a little, so keyboard events will not fire too fast

  end;

end;
// -- main --
var

  tid: cardinal;

  th: tHandle;

  fmt: tWAVEFORMATEX;

  res: int;

begin

  event := CreateEvent(nil, false, false, nil);

  if (0 <> event) then begin

    //

    // start thread

    th := createThread(nil, 0, @thread_proc, nil, 0, tid);

    if (0 <> th) then begin

      //

      // prepare wave format

      fmt.wFormatTag := 1;

      fmt.nChannels := 1;

      fmt.nSamplesPerSec := sps;

      fmt.nAvgBytesPerSec := sps shl 1;

      fmt.nBlockAlign := 2;

      fmt.wBitsPerSample := 16;

      fmt.cbSize := 0;

      //

      res := WaveOutOpen(@wout, cardinal(-1), @fmt, event, 0, CALLBACK_EVENT);

      if (MMSYSERR_NOERROR = res) then begin

	//

	writeLn('Q/A - freq;  Left/Right - pause;  Up/Down - signal;  Enter - EXIT.'#13#10);

	//

	wasKey := true;

	repeat

	  //

	  if (key(ord('Q'))) then inc(freq, 10);

	  if (key(ord('A'))) then if (freq > 100) then dec(freq, 10);

	  if (key(VK_UP)) then inc(timeSignal, 10);

	  if (key(VK_DOWN)) then if (timeSignal > 10) then dec(timeSignal, 10);

	  if (key(VK_RIGHT)) then inc(timePause, 10);

	  if (key(VK_LEFT)) then if (timePause > 10) then dec(timePause, 10);;

	  //

	  if (wasKey) then

	    write('Freq: ', freq, 'Hz;  signal: ', timeSignal, 'ms;  pause: ', timePause, 'ms '#13);

	  //

	  if (key(VK_RETURN)) then

	    break;	// done

	  //

	  wasKey := false;

	  //

	until (false);

	//

	done := true;	// tell thread we are done

	WaitForSingleObject(th, 1000);	// wait for thread to terminate

	//

	waveOutReset(wout);

	WaveOutClose(wout);

	//

	writeln('Have a nice OS.');

      end

      else

	fail('Could not open wave device (MMERROR=' + IntToStr(res) + '.');

    end

    else

      fail('Could not create thread.');

  end

  else

    fail('Could not create event.');

end.