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

RN3QGA77

Дата 7.6.2006, 19:44 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

Доброго времени суток всем.
Вот решил звуковой генератор замастрячить.
Все вродебы получилось, но есть одно но.
Я использую вот такой код (взято с 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. smile

drkot

Дата 8.6.2006, 10:51 (ссылка)

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

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

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

Вынеси воспроизведение звука в отдельный поток + продолжительность одного "эпизода" сделай порядка 100 мс.
Это касательно как изменить.

А касательно как лучше: либо использовать DirectSound, либо найти компонент TAudio (есть на торри)
в таком случае реализация будет более правильная.

Для генерирования ваве последовательности стоит использовать обратное FFT, возможности генератора несказанно возрастут.

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

Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.

Snowy

Дата 8.6.2006, 11:07 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

Переделал на асинхронность, но теперь не функция, а класс.

Код

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 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

Snowy

Дата 9.6.2006, 18:02 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

Я ж всё написал.

Первый код сохрани в файл SndMaker.pas
Положи его в свою папку.
В uses пропиши SndMaker.

Далее.
Создай OnClick для первой кнопки.
пропиши в нем
SoundMaker.Play(200, 60); // 200 - частота в герцах, 60 - громкость 0-127
Создай OnClick для второй кнопки.
Пропиши в нем
SoundMaker.Stop;

Всё. Проще некуда.

RN3QGA77

Дата 12.6.2006, 18:11 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

RN3QGA77

Дата 13.6.2006, 14:51 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

Snowy

Дата 13.6.2006, 15:12 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

До воспроизведения установи

Код

SoundMaker.SampleRate := 44100;

Можно прямо в конструкторе заменить значение по умолчанию

Код

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

RN3QGA77

Дата 13.6.2006, 22:01 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

drkot

Дата 14.6.2006, 13:30 (ссылка)

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

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

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

Если хочеш могу на мыло тебе компонент скинуть. работает нормально глюков с воспроизведением не замечено.

Цитата(RN3QGA77 @ 13.6.2006, 22:01

)

Интересная штука чистый сигнал получается через определенные промежутки,

кинь пример. интересно посмотреть за счет чего глюк. (если код не секретный)

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

RN3QGA77

Дата 14.6.2006, 14:11 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

RN3QGA77

Дата 2.7.2006, 19:16 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 28.5.2006

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

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

aalor

Дата 19.12.2006, 16:51 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.11.2005

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

Цитата(RN3QGA77 @ 2.7.2006, 19:16)

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

я конечна в звуке болванчик, по просьбе прогу делаю,
вот объяснте- зачем дискредитация, и клиенту нана частота изменения частоты не к герцах а в сотых герца
это реально??

Snowy

Дата 19.12.2006, 17:05 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

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

aalor

Дата 19.12.2006, 17:26 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.11.2005

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

Цитата(Snowy @ 19.12.2006, 17:05)

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

спасибо, у мя возспроизвело, завтра поволоку заказчику

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