Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
21 ошибка прогр... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Имитационное мо... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Реклама
Сейчас на сайте
Гостей: 8
На сайте нет зарегистрированных пользователей

Пользователей: 13,365
новичок: ceexuwu
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Моделирование работы ЭВМ на GPSS + Пояснительная записка
Информационная система - транспортный парк на Turbo Pascal (База данных)...
Моделирование процесса поступления заявок в систему, состоящую из трёх Э...

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

При нажатии 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.
Какие материалы http://solo-project.com/view_articles.php?id=5
Опубликовал Kest November 29 2008 07:42:21 · 0 Комментариев · 13085 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Нет комментариев.
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Импорт новостей ...
index.php + мод ...
RAS
Синтаксический ан...
C++ Builder 6 СПР...
Counter [Исходник...
Керниган Б.В., Ри...
SysInfo [Исходник...
HtmlLerz PRO
DirHTMLReportBuil...
Игра в крестики н...
Exe in exe
Cooltray
Размещение элемен...
Краснов М. - Open...
Delphi 2005. Разр...
IconCut [Исходник...
Создание оригинал...
Технология .Net в VB
Библиотека програ...

Топ загрузок
Приложение Клие... 100774
Delphi 7 Enterp... 97832
Converter AMR<-... 20268
GPSS World Stud... 17014
Borland C++Buil... 14191
Borland Delphi ... 10290
Turbo Pascal fo... 7373
Калькулятор [Ис... 5984
Visual Studio 2... 5207
Microsoft SQL S... 3661
Случайные статьи
Разработка сайтов
Обмен ссылками, за...
«Кризис — время но...
Попытайтесь написа...
Схема кодирования,...
Анализ зависимости...
Изучение сложных б...
Инсталляция SWI-Pr...
Guide Plus+
Почтовый конверт
Группировка симво...
Перетаскивание окн...
ПМ Казино онлайн
FVARIABLE (ОПРЕДЕЛ...
Как задать парамет...
Процедура Rectangl...
филиале, вы ограни...
Тестирование
определена данная ...
Взлом Хотмыла
Функции выполняют ...
Многоразрядный дво...
RMULT (УСТАНОВИТЬ ...
Интегрирование нов...
Аффилиаты
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?