Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: декабрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Чтение и запись звука

Автор: Даниил Карапетян
WEB сайт: http://program.dax.ru

Все функции чтения и записи звука я выделил в отдельный модуль. Он приведен после текста программы.

При нажатии Button1 создается звуковой файл в памяти (то есть в памяти создается заголовок, затем идут данные - все точно так же, как в обычном wav-файле), сохраняется на диск и одновременно начинает воспроизводиться. Для этого используется функция playsound. Остановить воспроизведение можно кнопкой Button2.

При нажатии Button3 открывается файл ex.wav (если Вы уже нажимали Button1, то он существует). Далее из файла считываются данные и для каждого канала находится средняя громкость. Не уверен, что это самый правильный способ, но здесь за громкость я взял просто среднее арифметическое. Результаты выводятся в заголовок окна. Для каждого канала выводится значение в процентах от максимально возможной громкости.

Теперь о самой структуре данных. Она очень проста. Если канал один, то данные записаны подряд:

первое значение,
второе значение,
третье значение
...

Если же в файле два канала, то они чередуются:

первое значение первого канала, первое значение второго канала,
второе значение первого канала, второе значение второго канала,
третье значение первого канала, третье значение второго канала,
...

Если файл восьми битный, то каждое значение занимает 1 байт, если шестнадцати битный - 2 байта. Это соответствует типам shortint и smallint соответственно.

В этой программе данные записываются при помощи процедуры GetData. SaveSound вызывает ее для каждого значения. В качестве параметров передаются канал и номер. А возвращаемое значение передается через нетипизированный параметр res. Такой подход позволяет избежать проблем с типами данных.

При чтении все данные копируются в память, а затем находится сумма всех значений для каждого канала. При выводе громкости эти суммы делятся на максимально возможные суммы и умножаются на сто.

Скачать все необходимые для компиляции файлы проекта можно на program.dax.ru.


 uses MMSystem, wavfile;
 
 procedure TForm1.Button1Click(Sender: TObject);
 const
   fr = 11025; {Частота в герцах}
   len = 1; {Длина звука в секундах}
 
   procedure GetData(ch: smallint; index: integer; var res);
   var
     v: smallint absolute res; // конечное значение
     amp: single; // амплитуда
   begin
     if ch = 0
       then amp := sin(index * 2 * Pi / (fr * len))
       else amp := cos(index * 2 * Pi / (fr * len));
     v := round(amp * (random(60000) - 30000));
   end;
 
 var
   M: TMemoryStream; // поток для хранения информации в памяти
   F: TFileStream; // Поток для созранения файла
 begin
   M := nil; F := nil;
   try
     M := TMemoryStream.Create;
     randomize;
     SaveSound(M {Куда записывать}, round(fr * len) {len секунд},
       fr {частота}, 16 {16 бит}, 2 {2 каналла}, @GetData);
     // Воспроизведение звука:
     if not playsound(M.Memory, 0, SND_MEMORY or SND_LOOP or SND_ASYNC)
       then ShowMessage('Can not play the sound');
 
     F := TFileStream.Create('ex.wav', fmCreate);
     M.Position := 0;
     F.CopyFrom(M, M.Size);
   finally
     M.Free; F.Free;
   end;
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   playsound(nil, 0, 0); // Остановка воспроизведения
 end;
 
 procedure TForm1.Button3Click(Sender: TObject);
 var
   SampleCount, SamplesPerSec: integer;
   BitsPerSample, Channeles: smallint;
   F: TFileStream;
   Volume: array [0..1] of single;
   ToPercent: single;
   buf: pointer;
   buf8: ^shortint;
   buf16: ^smallint;
   i, ch: integer;
 begin
   F := nil; buf := nil;
   try
     Volume[0] := 0; Volume[1] := 0;
     F := TFileStream.Create('ex.wav', fmOpenRead);
     ReadWaveHeader(F, SampleCount, SamplesPerSec,
       BitsPerSample, Channeles);
 
     // Чтение данных:
     GetMem(buf, SampleCount * Channeles * BitsPerSample);
     F.Read(buf^, SampleCount * Channeles * BitsPerSample);
     if BitsPerSample = 8 then begin
       buf8 := buf;
       for i := 0 to SampleCount - 1 do
         for ch := 0 to Channeles - 1 do begin
           Volume[ch] := Volume[ch] + abs(buf8^);
           inc(buf8); // Переход к следующему элементу
         end
     end else begin
       buf16 := buf;
       for i := 0 to SampleCount - 1 do
         for ch := 0 to Channeles - 1 do begin
           Volume[ch] := Volume[ch] + abs(buf16^);
           inc(buf16); // Переход к следующему элементу
         end;
     end;
 
     // Вывод результатов:
     ToPercent := (1 shl BitsPerSample) / 100 * SampleCount;
     if Channeles = 1
       then Form1.Caption := Format('volume: %2.2f%%',
         [Volume[0] / ToPercent])
       else Form1.Caption := Format('left: %2.2f%%, right: %2.2f%%',
         [Volume[0] / ToPercent, Volume[1] / ToPercent]);
   finally
     F.Free;
     FreeMem(buf);
   end;
 end;
 
 --------------------------------------------------------------------------------
 
 unit wavfile;
 
 interface
 
 uses classes, sysutils;
 
 type
   TWaveHeader = record
     idRiff: array [0..3] of char;
     RiffLen: longint;
     idWave: array [0..3] of char;
     idFmt: array [0..3] of char;
     InfoLen: longint;
     WaveType: smallint;
     Ch: smallint;
     Freq: longint;
     BytesPerSec: longint;
     align: smallint;
     Bits: smallint;
   end;
 
   TDataHeader = record
     idData: array [0..3] of char;
     DataLen: longint;
   end;
 
   TGetData = procedure(ch: smallint; index: integer; var res);
   TSetData = procedure(ch: smallint; index: integer; data: smallint);
 
 procedure CreateWaveHeader(SampleCount, SamplesPerSec: integer;
   BitsPerSample, Channeles: smallint; var WaveHeader: TWaveHeader;
   var DataHeader: TDataHeader);
 procedure ReadWaveHeader(Stream: TStream;
   var SampleCount, SamplesPerSec: integer;
   var BitsPerSample, Channeles: smallint);
 procedure SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
   BitsPerSample, Channeles: smallint; GetData: TGetData);
 
 implementation
 
 procedure Creat
   BitsPerSample, Channeles: smallint; var WaveHeader: TWaveHeader;
   var DataHeader: TDataHeader);
 var
   len: integer;
 begin
   if (SampleCount <  0) or (SamplesPerSec <  1) or
     (not BitsPerSample in [8, 16]) or
     (not Channeles in [1, 2])
     then raise Exception.Create('Wrong params');
 
   len := SampleCount * BitsPerSample div 8 * Channeles;
   with WaveHeader do begin
     idRiff := 'RIFF';
     RiffLen := len + 38;
     idWave := 'WAVE';
     idFmt := 'fmt ';
     InfoLen := 16;
     WaveType := 1;
     Ch := Channeles;
     Freq := SamplesPerSec;
     BytesPerSec := SamplesPerSec * BitsPerSample div 8 * Channeles;
     align := Channeles * BitsPerSample div 8;
     Bits := BitsPerSample;
   end;
   with DataHeader do begin
     idData := 'data';
     DataLen := len;
   end;
 end;
 
 procedure ReadWaveHeader(Stream: TStream;
   var SampleCount, SamplesPerSec: integer;
   var BitsPerSample, Channeles: smallint);
 var
   WaveHeader: TWaveHeader;
   DataHeader: TDataHeader;
 begin
   Stream.Read(WaveHeader, sizeof(TWaveHeader));
   with WaveHeader do begin
     if idRiff < >  'RIFF' then raise EReadError.Create('Wrong idRIFF');
     if idWave < >  'WAVE' then raise EReadError.Create('Wrong idWAVE');
     if idFmt < >  'fmt ' then raise EReadError.Create('Wrong idFmt');
     if WaveType < >  1 then raise EReadError.Create('Unknown format');
     Channeles := Ch;
     SamplesPerSec := Freq;
     BitsPerSample := Bits;
     Stream.Seek(InfoLen - 16, soFromCurrent);
   end;
   Stream.Read(DataHeader, sizeof(TDataHeader));
   if DataHeader.idData = 'fact' then begin
     Stream.Seek(4, soFromCurrent);
     Stream.Read(DataHeader, sizeof(TDataHeader));
   end;
   with DataHeader do begin
     if idData < >  'data' then raise EReadError.Create('Wrong idData');
     SampleCount := DataLen div (Channeles * BitsPerSample div 8)
   end;
 end;
 
 procedure SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
   BitsPerSample, Channeles: smallint; GetData: TGetData);
 var
   WaveHeader: TWaveHeader;
   DataHeader: TDataHeader;
   buf: smallint;
   BytesPerSample: smallint;
   i: integer;
 begin
   CreateWaveHeader(SampleCount, SamplesPerSec, BitsPerSample,
     Channeles, WaveHeader, DataHeader);
   Stream.Write(WaveHeader, sizeof(TWaveHeader));
   Stream.Write(DataHeader, sizeof(TDataHeader));
   BytesPerSample := BitsPerSample div 8;
   if Channeles = 1
   then
     for i := 0 to SampleCount - 1 do begin
       GetData(0, i, buf);
       Stream.Write(buf, BytesPerSample);
     end
   else
     for i := 0 to SampleCount - 1 do begin
       GetData(0, i, buf);
       Stream.Write(buf, BytesPerSample);
       GetData(1, i, buf);
       Stream.Write(buf, BytesPerSample);
     end;
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS