
Последние записи
- Убить процесс
- Конвертер heic в jpg
- Проверка на шестнадцатеричный формат записи
- Отдать пользователю файл с помощью file_get_contents()
- Написать собственую функцию operator[] для битов
- Проблема с движением 2D человека
- OpenGl.Создание винтовой лестницы
- Склеить несколько файлов в один
- Windows 10 сменить администратора
- Рандомное слайдшоу

Интенсив по 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.
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту

пеллетные котлы

Пеллетный котел Emtas

Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)