VPF::Звуковой генератор - Форум программистов

HedgeR

Дата 10.2.2007, 00:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 3.2.2007
Где: Москва

Репутация: нет
Всего: нет

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

Alexeis

Дата 10.2.2007, 15:32 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Таки я был прав. Вот результат. Соединил OUT с LineIn кабелем и записал при помощи рограммы
BlazeMediaPro

Когда уровень звука установленный регулятором LineIn был небольшим, получилась следующая картина

1) 1 период
user posted image

2) Тоже но при меньшем масштабе

user posted image

А вот потом поставил регулятор LineIn на максимум и вот он результат такой же как и у вас.

3) Слишком большой уровень усиления при записи

user posted image

Это сообщение отредактировал(а) Alexeis - 10.2.2007, 15:33

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Alexeis

Дата 11.2.2007, 12:20 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Переделал модуль для генерации звука, добавив к нему функцию создания стереоэффекта.
Функция

Код


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:26

--------------------

Alexeis

Дата 11.2.2007, 12:38 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

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

--------------------

HedgeR

Дата 11.2.2007, 16:25 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 3.2.2007
Где: Москва

Репутация: нет
Всего: нет

Alexeis, спасибо огромное smile

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

Alexeis

Дата 11.2.2007, 16:52 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(HedgeR @ 11.2.2007, 16:25

)

наблюдаются непонятные изменения амплитуды каналов

Так это наверное на слух. Так и должно быть. Это результат интерференции. Колебания на выходе постоянной амплитуды.

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »