Форум программистов
 
Расширенный поиск
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Excel VBA, CAD, Софт, ОС, Windows, Ubuntu, Android, VPS
Win Api, Assembler, C++, Java, Pascal, Lazarus, Delphi, OpenGL, DirectX
C#, Qt, .NET, ASP.NET, Windows Forms, ADO.NET, Framework, WPF, UWP, WinRT, XAML
HTML, CSS, JavaScript, Ajax, PHP, Perl, Python, Ruby, SQL, WordPress, API, XML, JSON, ActionScript, Flash

Ответ
 
Опции темы
Старый 19.03.2017, 16:40   #1
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 387
Репутация: 87
По умолчанию Запись звука в WAV-файл (без BASS.DLL)

Здравствуйте.
Перечитал на эту тему много всего и перепробовал много разных примеров кода.
Нормально работает только этот:
Код:


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem;

type
  TData8 = array [0..127] of byte;
  PData8 = ^TData8;
  TData16 = array [0..127] of smallint;
  PData16 = ^TData16;
  TPointArr = array [0..127] of TPoint;
  PPointArr = ^TPointArr;
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    PaintBox1: TPaintBox;
    TrackBar1: TTrackBar;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  WaveIn: hWaveIn;
  hBuf: THandle;
  BufHead: TWaveHdr;
  bufsize: integer;
  Bits16: boolean;
  p: PPointArr;
  stop: boolean = false;

procedure TForm1.Button1Click(Sender: TObject);
var
  header: TWaveFormatEx;
  BufLen: word;
  buf: pointer;
begin
  BufSize := TrackBar1.Position * 500 + 100; { Размер буфера }
  Bits16 := CheckBox1.Checked;
  with header do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1; { количество каналов }
    nSamplesPerSec := 22050; { частота }
    wBitsPerSample := integer(Bits16) * 8 + 8; { 8 / 16 бит }
    nBlockAlign := nChannels * (wBitsPerSample div 8);
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize := 0;
  end;
  WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
  Form1.Handle, 0, CALLBACK_WINDOW);
  BufLen := header.nBlockAlign * BufSize;
  hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  Buf := GlobalLock(hBuf);
  with BufHead do
  begin
    lpData := Buf;
    dwBufferLength := BufLen;
    dwFlags := WHDR_BEGINLOOP;
  end;
  WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
  WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
  GetMem(p, BufSize * sizeof(TPoint));
  stop := true;
  WaveInStart(WaveIn);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if stop = false then
    Exit;
  stop := false;
  while not stop do
    Application.ProcessMessages;
  stop := false;
  WaveInReset(WaveIn);
  WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
  WaveInClose(WaveIn);
  GlobalUnlock(hBuf);
  GlobalFree(hBuf);
  FreeMem(p, BufSize * sizeof(TPoint));
end;

procedure TForm1.OnWaveIn;
var
  i: integer;
  data8: PData8;
  data16: PData16;
  h: integer;
  XScale, YScale: single;
begin
  h := PaintBox1.Height;
  XScale := PaintBox1.Width / BufSize;
  if Bits16 then
  begin
    data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
    YScale := h / (1 shl 16);
    for i := 0 to BufSize - 1 do
      p^[i] := Point(round(i * XScale),
    round(h / 2 - data16^[i] * YScale));
  end
  else
  begin
    Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
    YScale := h / (1 shl 8);
    for i := 0 to BufSize - 1 do
      p^[i] := Point(round(i * XScale),
    round(h - data8^[i] * YScale));
  end;
  with PaintBox1.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(ClipRect);
    Polyline(Slice(p^, BufSize));
  end;
  if stop then
    WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
  else
    stop := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2.Click;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if stop then
  begin
    Button2.Click;
    Button1.Click;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TrackBar1.OnChange := CheckBox1Click;
  Button1.Caption := 'Start';
  Button2.Caption := 'Stop';
  CheckBox1.Caption := '16 / 8 bit';
end;

end.

А как писать полученное аудио в файл?
Если я правильно понял, сначала нужно создать и записать заголовок WAV. А потом в OnWaveIn делать
Код:

    BlockWrite(fOut,pwavehdr(Msg.LParam),pwavehdr(Msg.LParam).dwBufferLength);

Нашел вот такую структуру
Код:

type
 TWaveHeader = record
  Marker1: Array[0..3] of Char;
  BytesFollowing: LongInt;
  Marker2: Array[0..3] of Char;
  Marker3: Array[0..3] of Char;
  Fixed1: LongInt;
  FormatTag: Word;
  Channels: Word;
  SampleRate: LongInt;
  BytesPerSecond: LongInt;
  BytesPerSample: Word;
  BitsPerSample: Word;
  Marker4: Array[0..3] of Char;
  DataBytes: LongInt;
end;

но не понятно как ее правильно заполнять. Что такое Fixed1, DataBytes?

Программа рисует график звука, а в файл какой-то мусор скидывается. То ли я заголовок неправильно создаю, то ли скидываю неправильно (в этом коде создания заголовка нет, а так-то я его создаю).
Код:

procedure MakeHeader;
var
  head : TWaveHeader;
begin
   with Head do
   begin
      Marker1 := 'RIFF';
      BytesFollowing :=  36; //????
      Marker2 := 'WAVE';
      Marker3 := 'fmt';
      Fixed1 := 16; // ???
      FormatTag := WAVE_FORMAT_PCM;
      SampleRate := SampleRate;
      Channels := nChannels;
      BytesPerSecond := Channels;
      BytesPerSecond := Head.BytesPerSecond * SampleRate;
      BytesPerSecond :=Head.BytesPerSecond * nBits;
      BytesPerSecond := Head.BytesPerSecond div 8;
      BytesPerSample := Channels * 8 div 8;
      BitsPerSample := nBits;
      Marker4 := 'data';
      DataBytes := 0; // ??
   end;
  AssignFile(fOut,fileName);
  Rewrite(fOut);
   BlockWrite(fOut,Head,sizeof(TWaveHeader));
end;

Подскажите, как правильно создать заголовок.

Последний раз редактировалось BLACK_RAIN; 19.03.2017 в 16:43.
BLACK_RAIN вне форума   Ответить с цитированием
Старый 20.03.2017, 21:13   #2
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: Санкт-Петербург
Сообщений: 612
Репутация: 280
По умолчанию

Код:

procedure SaveWavFile(afreq, achans: Dword; FileName: string; Buffer: pointer; Size: Integer);
  type
    PWaveHeader = ^TWaveHeader;
    TWaveHeader = record
    idRiff        : array [0..3] of Char;
    RiffLen       : LongInt;
    idWave        : Array[0..3] of Char;
    idFmt         : Array[0..3] of Char;
    InfoLen       : LongInt;
    FormatTag     : Word;
    Channels      : Word;
    Freq          : LongInt;
    BytesPerSec   : LongInt;
    BlockAlign    : Word;
    BitsPerSample : Word;
    idData        : Array[0..3] of Char;
    DataBytes     : LongInt;
  end;

var
  header: TWaveHeader;
  f : File;
  iSeek: Integer;
begin

if (Buffer <> nil)and(Size > 0) then
begin
   FillChar(header, SizeOf(TWaveHeader), 0);

    {$I-}
   AssignFile(f, FileName);
   FileMode := fmOpenReadWrite;
   Reset(f, 1);
   {$I+}
   if IOResult > 0 then
   rewrite(F, 1)
   else
   begin
   seek(f, 0);
   BlockRead(f, header, SizeOf(TWaveHeader)); 
   end;

//читаем заголовок для того чтобы данные размера прибавить
   with header do
  begin
    idRiff        :='RIFF';
    RiffLen       := SizeOf(TWaveHeader);
    idWave        :='WAVE';
    idFmt         :='fmt ';
    InfoLen       := 16;
    FormatTag     := 1;
    Channels      := achans;
    Freq          := afreq;
    BitsPerSample := 8;
    BlockAlign    := Channels * (BitsPerSample div 8);
    BytesPerSec   := Freq * BlockAlign;
    idData        :='data';
    DataBytes     := DataBytes + Size;
  end;

 //Сохраняем заголовок
 seek(f, 0);
 BlockWrite(f, header, SizeOf(TWaveHeader));
 //Сохраняем данные звука
 iSeek:= filesize(f);
 seek(f, iSeek);
 BlockWrite(f, Buffer^, Size);
 CloseFile(f);
 end;
 end;

Использовать примерно так SaveWavFile(22050, 2, 'F:\1111.wav', buffer, Size);

Последний раз редактировалось Aliens_wolfs; 20.03.2017 в 21:26.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 21.03.2017, 11:23   #3
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 387
Репутация: 87
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
BytesPerSec := Freq * BlockAlign;
на счет этого не понятно. В интернете в разных примерах по разному написано. В нескольких статьях читал, что надо так:
Код:

dwBytesPerSec := (nSampleRate * nBits * nChannels) div 8;

как же правильно?
BLACK_RAIN вне форума   Ответить с цитированием
Старый 21.03.2017, 21:07   #4
Pavia
Лис
Участник клуба
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 963
Репутация: 1125
По умолчанию

Цитата:
Сообщение от BLACK_RAIN Посмотреть сообщение
на счет этого не понятно. В интернете в разных примерах по разному написано. В нескольких статьях читал, что надо так:
Код:

dwBytesPerSec := (nSampleRate * nBits * nChannels) div 8;

как же правильно?
Помнится я уже где-то описывал, как правильно. Только не помню где.
Суть простая. Никто не знает как правильно.
Стоит придерживаться официальной документации майкрософта:
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
Но! Если посмотреть их исходники масдая утекшие в народ.
- Идёт проверка на равенство BytesPerSec = Freq * BlockAlign;
- А вот вычисление BlockAlign происходит, не так как описано на MSDN, а хитрым образом.
Во-первых BlockAlign зависит от WAVE_FORMAT_EXTENSIBLE.
Если включено, то вычисляем, по BlockAlign := Channels * (BitsPerSample div 8);
А вот если выключено, то там должно быть выравнено на границе 16 бит. *
BlockAlign := Channels * (BitsPerSample+15) div 16);
Но опять таки разночтение породило вот, что:
http://forum.sources.ru/index.php?showtopic=310684&st=0
На разных компьютерах с одной системой работал один вариант код и не работал другой. Выбор вариант ещё зависит от драйвера и вашей звуковой карты!

*) Как вы видите товарищи выравнивали код на 32 биной границы, а не на 16 битной как указано в формате RIFF. Так что это тоже вопрос открытый.
__________________
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума   Ответить с цитированием
Старый 21.03.2017, 21:57   #5
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: Санкт-Петербург
Сообщений: 612
Репутация: 280
По умолчанию

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

Если все таки хотите придерживаться хоть какого нибудь стандарта звуковых значений, то откройте любой wav файл из папки Windows\Media\ прочитайте его заголовок и сравните с вашими значениями, это и будет тем стандартом которого можете придерживаться в данном случае майкрософт.

Последний раз редактировалось Aliens_wolfs; 21.03.2017 в 23:13.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 22.03.2017, 08:00   #6
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 387
Репутация: 87
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
откройте любой wav файл из папки Windows\Media\ прочитайте его заголовок и сравните с вашими значениями, это и будет тем стандартом которого можете придерживаться в данном случае майкрософт.
формулу этим способом не узнаешь
BLACK_RAIN вне форума   Ответить с цитированием
Старый 22.03.2017, 11:59   #7
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 174
Репутация: 338
По умолчанию

http://www.frolov-lib.ru/books/bsp/v15/ch2_4.htm <-- Тут есть формулы
http://www.freepascal.ru/forum/viewt...hp?f=10&t=6761
Filka вне форума   Ответить с цитированием
Старый 22.03.2017, 13:31   #8
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: Санкт-Петербург
Сообщений: 612
Репутация: 280
По умолчанию

Цитата:
формулу этим способом не узнаешь
Пусть сравнит с известными ему формулами в dwBytesPerSec из файла если хочет иметь какой то стандарт значений

Последний раз редактировалось Aliens_wolfs; 22.03.2017 в 13:33.
Aliens_wolfs вне форума   Ответить с цитированием
Старый 22.03.2017, 13:40   #9
BLACK_RAIN
Форумчанин
 
Регистрация: 13.02.2012
Сообщений: 387
Репутация: 87
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Пусть сравнит с известными ему формулами в dwBytesPerSec из файла если хочет иметь какой то стандарт значений
какой же это стандарт, если формула толком не известна?
BLACK_RAIN вне форума   Ответить с цитированием
Старый 22.03.2017, 19:42   #10
Aliens_wolfs
Участник клуба
 
Регистрация: 16.12.2009
Адрес: Санкт-Петербург
Сообщений: 612
Репутация: 280
По умолчанию

Цитата:
какой же это стандарт, если формула толком не известна?
Просто экспериментально, сравните с полученного заголовка из wav файла параметры BytesPerSec, BlockAlign и BitsPerSample с одинаковой частотой и колич. каналов значения со своими значениями которые у вас получились, возможно они будут схожими с вашими, тогда и поймете для себя что у вас есть привязка к майкрософт стандарту.

Согласен с Pavia
Цитата:
Суть простая. Никто не знает как правильно.

Последний раз редактировалось Aliens_wolfs; 22.03.2017 в 20:09.
Aliens_wolfs вне форума   Ответить с цитированием
Ответ



Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
bass Запись звука со всего компьютера jhonyxakep Мультимедиа в Delphi 6 23.03.2017 12:47
BASS.dll - Пауза во время записи звука DenProx Общие вопросы Delphi 7 29.11.2016 14:58
Bass.dll не воспроизводится wav KrockodilL Мультимедиа в Delphi 2 16.03.2012 16:09
Bass.dll -непрерывное воспроизведение звука werrey Мультимедиа в Delphi 9 13.06.2011 15:23
Запись звука в BASS Gr@nd Мультимедиа в Delphi 1 18.09.2009 18:17




08:15.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Покупайте на сайте www.skinon.ru уникальные чехлы и наклейки для телефонов.
купить трафик


как улучшить посещаемость, а также решения по монетизации сайтов, видео и приложений

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru