Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.12.11;
Скачать: [xml.tar.bz2];

Вниз

Генерация звука с помощью функций WIN API   Найти похожие ветки 

 
Игорь Степанов   (2005-10-04 18:46) [0]

Уважаемые мастера,

Подскажите, пожалуйста, как генерировать чистый тон, например частотой 300 Гц так, чтобы эту генерацию можно было бы остановить по событию, например, нажатию какой-либо клавиши?

С уважением,
Игорь Степанов


 
vvvaaa   (2005-10-04 19:23) [1]

Ниже следующая функция воспроизводит тон определенной частоты и длительности. А останавливать можно либо заранее просчитывать длительность, либо запускать в цикле и прерывать по какому-либо признаку.

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;


 
Игорь Степанов   (2005-10-06 18:15) [2]

Большое спасибо.

Игорь Степанов


 
Игорь Степанов   (2005-10-08 17:10) [3]

Уважаемый vvvaaa,

Я разобрался в примере, но не понимаю, что это за тип TVolumeLevel? Такого в справочнике по Делфи нет. Как его определить? Компилятор выдает ошибку "Undeclared identifier".

С уважением, Игорь Степанов


 
GanibalLector ©   (2005-10-08 20:38) [4]


type
 TVolumeLevel = 0..127;


 
Игорь Степанов   (2005-10-10 19:07) [5]

Я запустил программу. Обнаружилось, что работает только в синхронном режиме. Если записать так:
sndPlaySound(MS.Memory, SND_MEMORY or SND_ASYNC);

то не запускается.

Я изготовил звуковой файл с чистым тоном достаточно большой длины и с помощью той же функции sndPlaySound(MS.Memory, SND_MEMORY or SND_ASYNC); надежно запускаю и прерываю его. Для моей задачи это решение оказалось оптимальным.

Спасибо за советы и помощь,

Игорь Степанов



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.12.11;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.04 c
4-1128601644
AngelFire
2005-10-06 16:27
2005.12.11
Перехват ввода


2-1132783881
quadronik
2005-11-24 01:11
2005.12.11
progressBar для FTP клиента


14-1132144432
dr Tr0jan
2005-11-16 15:33
2005.12.11
Глюк в Multisim (EWB)


6-1125037197
Windows
2005-08-26 10:19
2005.12.11
Проблема с функцие определения подключения к интернету


2-1132944808
Бандерас
2005-11-25 21:53
2005.12.11
Обычная задачка





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский