Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Звуковой генератор

Автор: RN3QGA77 7.6.2006, 19:44

Доброго времени суток всем. Вот решил звуковой генератор замастрячить. Все вродебы получилось, но есть одно но. Я использую вот такой код (взято с DRKB): Код uses     MMSystem;   type     TVolumeLevel = 0..127;   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;   // How to call the function:   procedure TForm1.Button1Click(Sender: TObject);   begin     MakeSound(1200, 1000, 60);   end;   так вод,  как бы мне сделать так, чтобы можно было одной кнопкой включать, а другой выключать сигнал, а то звучит по заданному времени и в это время форма и все, что на ней не реагируют на клики мышкой. Ну надеюсь понятно описал. С пасибо,  буду весьма признателен за помощь. С уважением RN3QGA77.

Автор: drkot 8.6.2006, 10:51

Вынеси воспроизведение звука в отдельный поток + продолжительность одного "эпизода" сделай порядка 100 мс. Это касательно как изменить. А касательно как лучше: либо использовать DirectSound, либо найти компонент TAudio (есть на торри) в таком случае реализация будет более правильная. Для генерирования ваве последовательности стоит использовать обратное FFT, возможности генератора несказанно возрастут.

Автор: Snowy 8.6.2006, 11:07

Переделал на асинхронность, но теперь не функция, а класс. Код unit SndMaker; interface uses Windows, Classes, MMSystem; type   TSoundMaker = class   private     ms: TMemoryStream;     FPlaing: Boolean;   public     SampleRate: word; // 8000, 11025, 22050, or 44100     constructor Create;     destructor Destroy; override;     procedure Play(Freq: dword; Vol: byte);     procedure Stop;   end; var SoundMaker: TSoundMaker; implementation { TSoundChanel } constructor TSoundMaker.Create; begin   ms := TMemoryStream.Create;   SampleRate := 11025; end; destructor TSoundMaker.Destroy; begin   Stop; ms.Free;   inherited; end; procedure TSoundMaker.Play(Freq: dword; Vol: byte); var   WaveFormatEx: TWaveFormatEx;   i, TempInt, DataCount, RiffCount: integer;   SoundValue: byte;   w: double; const   Mono: Word = $0001;   RiffId: string = 'RIFF';   WaveId: string = 'WAVE';   FmtId: string = 'fmt ';   DataId: string = 'data'; begin   if Freq > (0.6 * SampleRate) then Exit;   Stop;   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;   with ms do begin     Clear;     DataCount := SampleRate div 100;     RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +       SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount;     Write(RiffId[1], 4);     Write(RiffCount, SizeOf(DWORD));     Write(WaveId[1], Length(WaveId));     Write(FmtId[1], Length(FmtId));     TempInt := SizeOf(TWaveFormatEx);     Write(TempInt, SizeOf(DWORD));     Write(WaveFormatEx, SizeOf(TWaveFormatEx));     Write(DataId[1], Length(DataId));     Write(DataCount, SizeOf(DWORD));     w := 2 * Pi * Freq;     for i := 0 to DataCount - 1 do     begin       SoundValue := 127 + trunc(Vol * sin(i * w / SampleRate));       Write(SoundValue, SizeOf(Byte));     end;     FPlaing := True;     PlaySound(MS.Memory, 0, SND_ASYNC or SND_LOOP or SND_MEMORY);   end; end; procedure TSoundMaker.Stop; begin   if FPlaing then begin     PlaySound(MS.Memory, 0, SND_ASYNC or SND_PURGE or SND_MEMORY);     FPlaing := False;   end; end; initialization   SoundMaker := TSoundMaker.Create; finalization   SoundMaker.Free; end. Использование: Код uses SndMaker; procedure TForm1.btn1Click(Sender: TObject); begin   SoundMaker.Play(200, 60); // 200 - частота в герцах, 60 - громкость 0-127 end; procedure TForm1.btn2Click(Sender: TObject); begin   SoundMaker.Stop; end; P.S. создавать SoundMaker не нужно - он сам создаётся и уничтожается.

Автор: RN3QGA77 9.6.2006, 17:47

Доброго времени суток. Snowy это то, что мне нужно, но я честно говоря не совсем разобрался как мне это воплотить на форме с двумя кнопками, нельзя ли поподробней мне бестолковому,  или рабочий пример кинуть? С уважением RN3QGA77.

Автор: Snowy 9.6.2006, 18:02

Я ж всё написал. Первый код сохрани в файл SndMaker.pas Положи его в свою папку. В uses пропиши SndMaker. Далее. Создай OnClick для первой кнопки. пропиши в нем SoundMaker.Play(200, 60); // 200 - частота в герцах, 60 - громкость 0-127 Создай OnClick для второй кнопки. Пропиши в нем SoundMaker.Stop; Всё. Проще некуда.

Автор: RN3QGA77 12.6.2006, 18:11

Доброго времени всем.  Ну вот, что значит хорошая "тормозная система", ну тупим иногда, что ж... Все работает ОК. Огромное спасибо тебе Snowy  . С уважением RN3QGA77.

Автор: RN3QGA77 13.6.2006, 14:51

Опять привет. Значидца доделал я генератор, но заметил одну неприятную вещь, качество сигнала оставляет быть лучшим. Глянул по осцилографу, присутствует непонятная бурчащая составляющая. Начал разбираться и пришел к выводу, что дело в соотношении частоты с дискретизацией. В прошлом варианте я задавал  переменную дискретизации присваивал ей значение выбранной частоты и умножал её на 3, получалось качество отличное, попробывал в варианте по Snowy, что то не могу задать я переменную (SamplRate см. код в 3 топике от Snowy) либо не правильно это делаю, хотя стандартно . Провел пару эксперементов и выяснил, что наивысшее качество получается когда частота дискретизации больше выбранной частоты  в 3-3,3 раза. Подскажите как же мне её задать то ? Ну думаю описал проблему понятно ? Заранее благодарен, с уважением RN3QGA77.

Автор: Snowy 13.6.2006, 15:12

До воспроизведения установи Код   SoundMaker.SampleRate := 44100; Можно прямо в конструкторе заменить значение по умолчанию Код constructor TSoundMaker.Create; begin   ms := TMemoryStream.Create;   SampleRate := 11025; // можно прямо здесь заменить на 44100, чтобы потом не переприсваивать end;

Автор: RN3QGA77 13.6.2006, 22:01

Доброй ночи. Да Snowy, то, что в конструкторе менять можно дискрет, то я так и делал, я не дотюмкал что можно присваивать до начала воспроизведения. Теперь почти все ОК. Создаю переменную умножаю на 3 и получаю чистейший тон (сигнал), но опять одно но ... Интересная штука чистый сигнал получается через определенные промежутки, а точнее -  для примера в Гц'ах:  (200-333, 400-433, 500 - 533 ну и т.д с этой закономерностью), если ставлю дискрет (8000 и т.д. ) то то же самое, но с другой последовательностью, вот интересно как же  сделать, чтоб по всей частоте от 0 до 20000 (мне больше не надо) был чистый сигнал может поможешь разобраться? Очень благодарен. С уважением RN3QGA77.

Автор: drkot 14.6.2006, 13:30

Если хочеш могу на мыло тебе компонент скинуть. работает нормально глюков с воспроизведением не замечено. Цитата(RN3QGA77 @  13.6.2006,  22:01 ) Интересная штука чистый сигнал получается через определенные промежутки, кинь пример. интересно посмотреть за счет чего глюк. (если код не секретный)

Автор: RN3QGA77 14.6.2006, 14:11

День добрый. Ну ежели можно drKot то скинь,  буду примного благодарен.([email protected]) А на счет примера нет никаких проблем он весь выше в топике от Snowy. Просто у меня на форме регулятор типа ползунка  его значения от 0 до 20000 Гц,  я  присваиваю его значение умноженное на 3 в переменную SamplRate(Дискретизация), да собственно и все, но получается такое интересное действо, а если прописать вручную SamplRate, то тоже самое получается,  но в других областях частот. Если может чего непонятно то дополню. С уважением RN3QGA77.

Автор: RN3QGA77 2.7.2006, 19:16

Все, вопрос решен спасибо всем за помощь!

Автор: aalor 19.12.2006, 16:51

Цитата(RN3QGA77 @ 2.7.2006,  19:16) Все, вопрос решен спасибо всем за помощь! я конечна в звуке болванчик, по просьбе прогу делаю,  вот объяснте- зачем дискредитация, и клиенту нана частота изменения частоты не к герцах а в сотых герца это реально??

Автор: Snowy 19.12.2006, 17:05

Замени Freq: dword на Freq: double Но вот сможет ли это звуковуха воспроизвести - вопрос другой...

Автор: aalor 19.12.2006, 17:26

Цитата(Snowy @ 19.12.2006,  17:05) Замени Freq: dword на Freq: double Но вот сможет ли это звуковуха воспроизвести - вопрос другой... спасибо, у мя возспроизвело, завтра поволоку заказчику

Автор: Snowy 20.12.2006, 11:55

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

Автор: HmeL 27.12.2006, 14:16

Snowy, а ты не пытался избавиться от щелчков в начале и в конце звуковой волны? мои эксперименты ничего хорошего не дали...

Автор: Snowy 27.12.2006, 14:19

У меня нет никаких щелчков. Попробуй потестить код на другой звуковой карте. Вероятно, проблема скорее аппаратная, нежели софтовая.

Автор: Alexeis 27.12.2006, 14:35

HmeL, Щелчки возникают при переключении буферов, вероятно не своевременно переключаются.

Автор: HmeL 27.12.2006, 15:17

Snowy, попробую дома, на работе встроенный звук. alexeis1, а программно это можно исправить?

Автор: Alexeis 28.12.2006, 10:22

Цитата(HmeL @  27.12.2006,  15:17 ) а программно это можно исправить?  Ой я и не обратил внимание, что тут используется playsound   . Тогда советую попробовать сделать длинну такой, чтоб в буфере укладывалось целое число периодов. Т.е. конец трека плавно переходил в его начало, без ступеньки.

Автор: HmeL 28.12.2006, 11:56

alexeis1, т.е. ты имеешь в виду, чтобы синусоида завершалась под конец волны? Точно! в Саунд Форже это помагало, надо бы и здесь попробовать. Спасибо!

Автор: HedgeR 4.2.2007, 21:55

я пишу подобную программу, но она должна еще уметь выдавать стерео звук, с возможностью сдвига фаз каналов относительно друг друга. Вопрос:  1.как это реализовать модификацией кода, приведенного выше? 2. если проверить генерируемый сигнал прогой (xttp://zeitnitz.de/Christian/Scope/Scope_en.html - там есть оч. много всего для генерации/анализа звука), то он не синусоидальный, как должен быть, а скорее квадратный. Дело в колебаниях, возникающих на частотах, кратных генерируемой. Вот что показывает та прога при анализе генерируемого моей прогой звука 500 гц: спектр: А это сигнал: Если же "срезать" при анализе генерируемого сигнала все "лишние" частоты (напр., Band Pass 350-600 Гц), то получится собссно то требуется генерировать в чистом виде: Вопрос №2: откуда берутся эти "лишние" колебания и как с ними бороться (программно))?

Автор: Alexeis 5.2.2007, 11:34

HedgeR, Очень вероятно, что вы неверно настрили генератор. Я только, что вывел на экран аудио данные, которые должны направляться на проигрывание, и вот что получил Генератор настроен следующим образом Код procedure TForm1.btn1Click(Sender: TObject); var  sm : TSoundMaker;  i : Integer;  d : byte; begin  sm := TSoundMaker.Create;  sm.Play(500, 100);  sm.ms.Position := 0;  sm.ms.Read(d, 1);  canvas.MoveTo(20, 300 - d);  for i := 1 to 109  do    Begin      sm.ms.Read(d, 1);      canvas.LineTo(20+i * 3, 300 - d);    end; end; Единственое, я убрал из модуля, воспроизведение звука и запись заголовков. Все остальное осталось как было. Масимально допустимый уровень при таких настройках 127, а частота 5000 Гц, но хорошее качество будет на частоте до 1000Гц. Вот еще один момент. Тут генерируется короткий импульс, спектр которого может быть похожим скорее на гаусовский колокол, чем на линейчатый, но гармоник такой большой амплитуды быть не должно, они могли возникнуть, только если указали омплитуду выше 127, при этом сигнал должен получиться сильно искаженный и соотв. иметь много гармоник.

Автор: HedgeR 5.2.2007, 22:23

забавно, но у меня прога, как и у   Alexeis, рисует идеальную синусоиду, а реально получается  - см выше... Настройки генератора: част. дискретизации - 44100 гц, звука - 500 гц, громкость- 100 (из 127). Непонятно откуда берутся гармоники... Хотя это, по сути, в необходимом мне применении генератора не суть важно, куда важнее сделать стерео звук со сдвигом фаз... вот с этим   ! тк простой заменой числа каналов с $0001 $0002 это очевидно не решается...

Автор: Alexeis 5.2.2007, 22:48

Показанная выше синусойда бывает только при ограничении сигнала на выходе. Изучите акустический тракт после звуковой карты. Вероятно у вас чувствительный высокоомный вход, и транзисторы входного каскада переходят в режим насыщения, либо по входу стоят защитные диоды включенные встречно. Такого ограничения быть не может в звуковухе, иначе бы вместо музыки она бы воспроизводила какафонию  Добавлено @ 22:51  Цитата(HedgeR @  5.2.2007,  22:23 ) Непонятно откуда берутся гармоники... Гармоники всегда содержаться при любой форме сигнала отличной от синусоиды. Только синус и косинус при разложении в ряд фурье дают одну частоту, все остальные имеют широкий спектр и конечно гармоники сигнала с наибольшей амплитудой.

Автор: HedgeR 6.2.2007, 02:11

Цитата(Alexeis @  5.2.2007,  22:48 ) Изучите акустический тракт после звуковой карты. после звуковой карты сигнал идет обратно в эту же звуковую карту на анализ. а внутри куда он идет изучать не буду - счас, разберу я новый ноутбук    Цитата(Alexeis @  5.2.2007,  22:48 ) Вероятно у вас чувствительный высокоомный вход, и транзисторы входного каскада переходят в режим насыщения, либо по входу стоят защитные диоды включенные встречно. можт я чего и не понимаю, но на анализ звук с генератора для проверки я подавал 2мя способами: через провод-петлю (выход-вход) и без оного, выбрав как канал записи "stereo mix"  (естессно, музыка на фоне не играла   ). В любом случае наблюдалась вышеуказанная картина, хотя( имхо - поправьте если не прав) во 2м случае транзисторы и диоды не играют роли пли анализе, тк петля софтовая.    Цитата(Alexeis @  5.2.2007,  22:48 ) Цитата(HedgeR @  5.2.2007,  22:23 )Непонятно откуда берутся гармоники...Гармоники всегда содержаться при любой форме сигнала отличной от синусоиды. а ПОЧЕМУ она отличается от синусоиды? насколько я понимаю, идет загон в буфер звуковухи сигнала  именно синусоидальной формы... да и судя по вашему скриншоту это именно так... да, все тесты повторно проводились и на десктопе с неплохой звуковухой, с ровно тем же результатом    и вообще вешать все косяки на звуковуху неправильно, тк в той же проге-анализаторе есть генератор, который мне и требуется на делфях реализовать. так вот, он выдает идеальный синус...

Автор: Alexeis 6.2.2007, 10:26

Цитата(HedgeR @  6.2.2007,  02:11 ) и вообще вешать все косяки на звуковуху неправильно, тк в той же проге-анализаторе есть генератор, который мне и требуется на делфях реализовать. так вот, он выдает идеальный синус...  Цитата(Alexeis @  5.2.2007,  22:48 ) Изучите акустический тракт после звуковой карты.    Про звуковую карту я ничего не говорил. Но режим насыщения, на лицо. Нужно пробовать, менять амплитуду сигнала и т.д. Может вместо Line in, сигнал подавался на микрофон? У микрофона чувствительный усилитель и наверняка есть ограничитель по входу, ведь его рабочее напряжение исчисляются мВ, а диоды имеют ступеньку, около 0,5в. Т.е. вполне вероятно, что там он есть.

Автор: HedgeR 6.2.2007, 13:54

Alexeis,  а вы пробовали сами проанализировать генерируемый сигнал той прогой? (xttp://zeitnitz.de/Christian/Scope/Scope_en.html) Очень интересен результат

Автор: Snowy 6.2.2007, 14:12

ИМХО, лишние шумы вносятся на аппаратном уровне. Рекомендую захватить выход какой-нибудь программой, типа Total Recorder и проанализировать полученный результат. Это и будет результат до прохождения через звуковую карту. А анализировать выведенный аналоговый сигнал и заново оцифрованный - дело неблагодарное  Особенно для встроенных звуковух.

Автор: HedgeR 10.2.2007, 00:47

ок, шумы подождут... кто-нибудь подскажет как сделать стерео сигнал с раздельным загоном данных по каналам (т.е. вносить сдвиг по фазе и т.д.)... Намучился, не понимаю. Помогите пожалуйста.

Автор: Alexeis 10.2.2007, 15:32

Таки я был прав. Вот результат. Соединил OUT с LineIn кабелем и записал при помощи рограммы  BlazeMediaPro Когда уровень звука установленный регулятором LineIn был небольшим, получилась следующая картина 1) 1 период 2) Тоже но при меньшем масштабе А вот потом поставил регулятор LineIn на максимум и вот он результат такой же как и у вас. 3) Слишком большой уровень усиления при записи

Автор: Alexeis 11.2.2007, 12:20

Переделал модуль для генерации звука, добавив к нему функцию создания стереоэффекта.  Функция  Код StereoPlay(Freq: dword; Vol: Integer; phase : Integer = 0; PhaseVelocity : Integer = 0); установка phase - позволяет установить фиксированную  разность фаз между каналами, в этом случае параметр PhaseVelocity не нужно указывать. Параметр PhaseVelocity позволяет создать эффект движения источника звука по кругу, т.е. с задает скорость изменения фазы. Задеться в градусах в секунду. Значения меньше 6 градусов не рекомендованы, поскольку уже 6 градусах / с фаза поменяется на 360 градусов за 1 минуту, т.е. будет формироваться буфер длинной в 10Мб. При меньших размерах скорости буфер больше не будет изменяться, т.е. после 1минуты наступит повторение, но будет скачок фазы. Диапазон частот расширил до 20КГц, но все стерео эффекты не слышны на высоких частотах, потому не стоит использовать частоты выше 10КГц. Громкость задается числом от 0 до 2^15 степени ~32000 Модуль Код unit SndMaker; interface uses Windows, Classes, MMSystem, math; type   TSoundMaker = class   private     ms: TMemoryStream;     FPlaing: Boolean;   public     SampleRate: word; // 8000, 11025, 22050, or 44100     constructor Create;     destructor Destroy; override;     procedure Play(Freq: dword; Vol: Integer);     procedure StereoPlay(Freq: dword; Vol: Integer; phase : Integer = 0;                          PhaseVelocity : Integer = 0);     procedure Stop;   end; var   SoundMaker: TSoundMaker; implementation { TSoundChanel } constructor TSoundMaker.Create; begin   ms := TMemoryStream.Create;   SampleRate := 44100; end; destructor TSoundMaker.Destroy; begin   Stop; ms.Free;   inherited; end; procedure TSoundMaker.Play(Freq: dword; Vol: Integer); var   WaveFormatEx: TWaveFormatEx;   i, TempInt, DataCount, RiffCount: integer;   SoundValue: byte;   w: double; const   Mono: Word = $0001;   RiffId: string = 'RIFF';   WaveId: string = 'WAVE';   FmtId: string = 'fmt ';   DataId: string = 'data'; begin   if Freq > (0.6 * SampleRate) then Exit;   Stop;   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;   with ms do begin     Clear;     DataCount := SampleRate div 100;     RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +       SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount;     Write(RiffId[1], 4);     Write(RiffCount, SizeOf(DWORD));     Write(WaveId[1], Length(WaveId));     Write(FmtId[1], Length(FmtId));     TempInt := SizeOf(TWaveFormatEx);     Write(TempInt, SizeOf(DWORD));     Write(WaveFormatEx, SizeOf(TWaveFormatEx));     Write(DataId[1], Length(DataId));     Write(DataCount, SizeOf(DWORD));     w := 2 * Pi * Freq;     for i := 0 to DataCount - 1 do     begin       SoundValue := 127 + trunc(Vol * sin(i * w / SampleRate));       Write(SoundValue, SizeOf(Byte));     end;     FPlaing := True;     PlaySound(MS.Memory, 0, SND_ASYNC or SND_LOOP or SND_MEMORY);   end; end; procedure TSoundMaker.StereoPlay(Freq: dword; Vol: Integer; phase : Integer = 0;                          PhaseVelocity : Integer = 0); var   WaveFormatEx: TWaveFormatEx;   i, TempInt, DataCount, RiffCount: integer;   LeftCh, RightCh : SmallInt;   w               : double;   SampInPeriod    : Extended;   PhasePeriod     : Integer;   PeriodsInPhasePeriod : Integer; const   Channels : Word = $0002;   RiffId   : string = 'RIFF';   WaveId   : string = 'WAVE';   FmtId    : string = 'fmt ';   DataId   : string = 'data'; begin   if Freq > (0.6 * SampleRate)   then     Exit;   Stop;      with WaveFormatEx   do     begin       wFormatTag      := WAVE_FORMAT_PCM;       nChannels       := Channels;       nSamplesPerSec  := SampleRate;       wBitsPerSample  := $0010;       nBlockAlign     := (nChannels * wBitsPerSample + 7) div 8;       nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;       cbSize := 0;     end;   with ms   do     begin       Clear;       SampInPeriod := SampleRate / Freq;       if (PhaseVelocity <> 0)       then         Begin           PhasePeriod := 360 div PhaseVelocity * SampleRate;           PeriodsInPhasePeriod := trunc(PhasePeriod / SampInPeriod);           PhasePeriod := round(PeriodsInPhasePeriod * SampInPeriod);           DataCount := min(trunc(trunc(10584000 / SampInPeriod) * SampInPeriod),                              round(PhasePeriod * WaveFormatEx.nBlockAlign));         End       else         DataCount := SampleRate * WaveFormatEx.nBlockAlign;              RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +         SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount;                Write(RiffId[1], 4);       Write(RiffCount, SizeOf(DWORD));       Write(WaveId[1], Length(WaveId));       Write(FmtId[1],  Length(FmtId));              TempInt := SizeOf(TWaveFormatEx);       Write(TempInt, SizeOf(DWORD));       Write(WaveFormatEx, SizeOf(TWaveFormatEx));       Write(DataId[1], Length(DataId));       Write(DataCount, SizeOf(DWORD));              w := 2 * Pi * Freq;              for i := 0 to DataCount div WaveFormatEx.nBlockAlign - 1 do       begin         LeftCh  := trunc(Vol * sin(i * w / SampleRate                                    + (phase + PhaseVelocity * i / SampleRate) *                                    Pi / 180));                                             RightCh := trunc(Vol * sin(i * w / SampleRate));                  Write(LeftCh, SizeOf(LeftCh));         Write(RightCh, SizeOf(RightCh));       end;       FPlaing := True;       Position := 0;       PlaySound(MS.Memory, 0, SND_ASYNC or SND_LOOP or SND_MEMORY);     end; end; procedure TSoundMaker.Stop; begin   if FPlaing then begin     PlaySound(NIL, 0, SND_ASYNC or SND_PURGE or SND_MEMORY);     FPlaing := False;   end; end; initialization   SoundMaker := TSoundMaker.Create; finalization   SoundMaker.Free; end.   Пример использования Код procedure TForm1.Button1Click(Sender: TObject); begin  SoundMaker.StereoPlay(200, 32000, 0, 360); end; procedure TForm1.Button2Click(Sender: TObject); begin    SoundMaker.Stop; end;

Автор: Alexeis 11.2.2007, 12:38

И еще, не советую менять длину буфера данных. Она подобрана так, чтобы общий сдвиг фаз менялся непрерывно без скачков от 0 до 360 градусов, и период основного колебания начинался и заканчивался той же самой фазой. Данный процесс состоит из медленной и быстрой смен фаз. Быстрый происходит с частотой колебания. Если начало не совпадет с концом по фазе, то будет характерный щелчок. Второй процесс медленная смена фазы. Но он тоже должен пробегать полный период иначе не будет эффекта движения по кругу.

Автор: HedgeR 11.2.2007, 16:25

Alexeis,  спасибо огромное      При первой проверке сдвига фаз приемлимый результат получился только в районе  1500 гц, выше/ниже наблюдаются непонятные изменения амплитуды каналов. Вечером посмотрю код  - поищу причину косяка Еще раз спасибо!

Автор: Alexeis 11.2.2007, 16:52

Цитата(HedgeR @  11.2.2007,  16:25 ) наблюдаются непонятные изменения амплитуды каналов  Так это наверное на слух. Так и должно быть. Это результат интерференции. Колебания на выходе постоянной амплитуды.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)