Аватар для Vadim00311
1 / 1 / 0
Регистрация: 22.10.2016
Сообщений: 105

Запись звука с микрофона в файл WAV

22.05.2019, 23:25. Показов 12732. Ответов 28

Студворк — интернет-сервис помощи студентам
Здравствуйте друзья! Думаю многим начинающим программистам Delphi будет интересна эта тема. К делу! В общем пытаюсь средствами API Windows записать звук с микрофона, а затем сохранить этом звук в Wav файл. Ошибок никаких нету, все отлично работает, создается файл wav, но он видимо неправильно записывается, т.к. Windows Media Player не может воспроизвести этот файл. И в свойствах файла ничего нет. Я скачал из сети wav файлы, там в свойствах скорость потока указана, а у меня нет ничего. Второй день голову ломаю. Может кто-нибудь из знатоков, если не сложно, укажет на ошибку?
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
unit Unit1;
 
    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 FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
     private
       { Private declarations }
     public
       procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
       procedure SaveWavFile(afreq, achans: Dword; FileName: string; Buffer: pointer; Size: Integer);
     end;
 
    var
     Form1: TForm1;
 
    implementation
 
    {$R *.DFM}
 
    var
     WaveIn: hWaveIn;
     hBuf: THandle;
     BufHead: TWaveHdr;
     bufsize: integer;
     Bits16: boolean;
     p: PPointArr;
     stop: boolean = false;
     hheader: TWaveFormatEx;
     buf: pointer;
 
    procedure TForm1.Button1Click(Sender: TObject);
    var
     BufLen: word;
    begin
     BufSize := TrackBar1.Position * 500 + 100;
     Bits16 := CheckBox1.Checked;
     with hheader do
     begin
       wFormatTag := WAVE_FORMAT_PCM;
       nChannels := 1;
       nSamplesPerSec := 22050;
       wBitsPerSample := integer(Bits16) * 8 + 8;
       nBlockAlign := nChannels * (wBitsPerSample div 8);
       nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
       cbSize := 0;
     end;
     WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(hheader),
       Form1.Handle, 0, CALLBACK_WINDOW);
     BufLen := hheader.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;
     SaveWavFile(hheader.nSamplesPerSec, hheader.nChannels, 'd:\1111.wav', BufHead.lpData, BufHead.dwBufferLength);
     stop := false;
     WaveInReset(WaveIn);
     WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
     WaveInClose(WaveIn);
     GlobalUnlock(hBuf);
     GlobalFree(hBuf);
     FreeMem(p, BufSize * sizeof(TPoint));
    end;
 
    procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if stop then
  begin
    Button2.Click;
    Button1.Click;
  end;
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.FormCreate(Sender: TObject);
begin
  TrackBar1.OnChange := CheckBox1Click;
  Button1.Caption := 'Start';
  Button2.Caption := 'Stop';
  CheckBox1.Caption := '16 / 8 bit';
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
    begin
     Button2.Click;
    end;
 
procedure TForm1.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;
 
end.
0
Лучшие ответы (1)
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
22.05.2019, 23:25
Ответы с готовыми решениями:

Запись звука с микрофона в файл WAV
Здравствуйте друзья! Думаю многим начинающим программистам Delphi будет интересна эта тема. К делу! В общем пытаюсь средствами API Windows...

Запись звука с микрофона и сохранение в wav
Добрый день, как записать wav файл с микрофона? Частота дискретизации = 122кб/с моно. Спасибо.

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

28
Модератор
4153 / 2362 / 814
Регистрация: 15.11.2015
Сообщений: 9,496
23.05.2019, 16:33
Студворк — интернет-сервис помощи студентам
Vadim00311, вот нашлась тема по этому поводу. Если нужны 1 байтовые символы, то в Delphi XE2 нужно использовать не char, а ansichar. Думаю, и здесь так же.

Delphi XE2 тип Char
0
 Аватар для Vadim00311
1 / 1 / 0
Регистрация: 22.10.2016
Сообщений: 105
23.05.2019, 16:42  [ТС]
Да, у меня Char по 2 байта

Добавлено через 1 минуту
Получается мне везде char нужно заменить на ansichar?
0
Модератор
4153 / 2362 / 814
Регистрация: 15.11.2015
Сообщений: 9,496
23.05.2019, 16:46
Да, во всех 4 местах в определении записи TWaveHeader.
0
 Аватар для Vadim00311
1 / 1 / 0
Регистрация: 22.10.2016
Сообщений: 105
23.05.2019, 17:05  [ТС]
Атом, ты красавчик! Спасибо тебе! Все работает.))))
0
 Аватар для Vadim00311
1 / 1 / 0
Регистрация: 22.10.2016
Сообщений: 105
23.05.2019, 23:45  [ТС]
Спасибо Атом! Ты мне очень помог дружище. Теперь сам попробую разобраться в коде)
1
Модератор
4153 / 2362 / 814
Регистрация: 15.11.2015
Сообщений: 9,496
24.05.2019, 09:41
Несколько уточнений. Ты Callback сделал по сообщению, это довольно удобно, но сообщения могут запаздывать. Например, если нажать мышкой на заголовок окна, то сообщения не будут приходить 1 секунду, за это время буферы для записи закончатся и будет пропуск.

Возможно лучше использовать не сообщения, а callback функцию (CALLBACK_FUNCTION), которую драйвер будет вызывать непосредственно. В этом случае пропусков не будет. В эту функцию так же передаётся адрес освободившегося буфера.

Ещё неплохо использовать CALLBACK_EVENT, но для этого лучше создать отдельный поток. И ещё нужно самому искать освободившийся буфер, проверяя флаги.
0
0 / 0 / 0
Регистрация: 25.10.2020
Сообщений: 2
25.10.2020, 23:10
Слушайте. Я скопировал весь пример, но мне нужны другие параметры записи - 2/16/44100

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, MMSystem;
 
type
  TModeDescr=record
    mode: DWORD;          // ??? ?????? ??????
    descr: string[32];    // ????????? ????????
  end;
 
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;
 
type
  PWaveHeader=^TWaveHeader;
 
  TWaveHeader=packed 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;
 
type
  TForm1=class(TForm)
    Button1: TButton;
    Button2: TButton;
    TrackBar1: TTrackBar;
    PaintBox1: TPaintBox;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
   //procedure ComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FWaveDataSize: dword;
    WaveF: integer;
    BufLen: integer;
    procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
    procedure SaveWavFile(afreq, achans: Dword; FileName: string; Buffer: pointer; Size: Integer);
    function CreateWaveFile(FileName: string; afreq, achans, abps: Dword): integer;
    function WriteWaveBuffer(F: integer; const Buffer; Count: integer): integer;
    procedure CloseWaveFile(F: integer);
  end;
 
 
var
  Form1: TForm1;
  WaveIn: hWaveIn;
  hBuf: THandle;
  BufHead1, BufHead2: TWaveHdr;
  bufsize: integer;
  Bits16: boolean;
  p: PPointArr;
  stop: boolean = true;
  hheader: TWaveFormatEx;
  buf1, buf2: pointer;
  Ch : Byte;
  SampleFreq :word;
  Bits: Byte;
 
implementation
 
{$R *.DFM}
 
procedure ShowInfo;
var
  WaveNums, i, j: integer;
  WaveInCaps: TWaveInCaps;   
begin
  WaveNums:=waveInGetNumDevs;
  if WaveNums>0 then
  begin
    for i:=0 to WaveNums-1 do
    begin
      waveInGetDevCaps(i, @WaveInCaps, sizeof(TWaveInCaps));
      Form1.ComboBox1.AddItem(IntToStr(i)+' '+PChar(@WaveInCaps.szPname), TObject(i));
    end;
    Form1.ComboBox1.ItemIndex:=0;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  BufSize:=TrackBar1.Position*500+100;
 
  with hheader do begin
    wFormatTag:=WAVE_FORMAT_PCM;
    nChannels:=Ch;
    nSamplesPerSec:=SampleFreq;
    wBitsPerSample:=Bits;
    nBlockAlign:=Ch*(Bits div 8);
    nAvgBytesPerSec:=SampleFreq*nBlockAlign;
    cbSize:=0;
  end;
  WaveF:=CreateWaveFile(ExtractFilePath(ParamStr(0))+'222.wav', hheader.nSamplesPerSec, hheader.nChannels, hheader.wBitsPerSample);
  WaveInOpen(Addr(WaveIn), Form1.ComboBox1.ItemIndex{WAVE_MAPPER}, addr(hheader), Form1.Handle, 0, CALLBACK_WINDOW);
  BufLen:=hheader.nBlockAlign*BufSize;
  GetMem(buf1, BufLen);
  GetMem(buf2, BufLen);
//  hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
//  Buf := GlobalLock(hBuf);
  FillChar(BufHead1, SizeOf(BufHead1), 0);
  BufHead1.lpData:=Buf1;
  BufHead1.dwBufferLength:=BufLen;
 
  FillChar(BufHead2, SizeOf(BufHead2), 0);
  BufHead2.lpData:=Buf2;
  BufHead2.dwBufferLength:=BufLen;
 
  WaveInPrepareHeader(WaveIn, Addr(BufHead1), sizeof(BufHead1));
  WaveInAddBuffer(WaveIn, addr(BufHead1), sizeof(BufHead1));
 
  WaveInPrepareHeader(WaveIn, Addr(BufHead2), sizeof(BufHead2));
  WaveInAddBuffer(WaveIn, addr(BufHead2), sizeof(BufHead2));
 
  GetMem(p, BufSize*sizeof(TPoint));
  stop:=false;
  WaveInStart(WaveIn);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  if stop then
    Exit;
  stop:=true;
  WaveInReset(WaveIn); // Ïîñëå WaveInReset áóôåðà îñâîáîæäàþòñÿ è âîçíèêàþò ñîáûòèÿ OnWaveIn
  WaveInUnPrepareHeader(WaveIn, addr(BufHead1), sizeof(BufHead1));
  WaveInUnPrepareHeader(WaveIn, addr(BufHead2), sizeof(BufHead2));
  WaveInClose(WaveIn);
  CloseWaveFile(WaveF);
//  SaveWavFile(hheader.nSamplesPerSec, hheader.nChannels, 'd:\1111.wav', BufHead1.lpData, BufHead1.dwBufferLength);
  FreeMem(buf1);
  FreeMem(buf2);
//  GlobalUnlock(hBuf);
//  GlobalFree(hBuf);
  FreeMem(p, BufSize*sizeof(TPoint));
end;
 
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if not stop then begin
    Button2.Click;
    Button1.Click;
  end;
end;
 
procedure TForm1.OnWaveIn;
var
  i: integer;
  data8: PData8;
  data16: PData16;
  h: integer;
  XScale, YScale: single;
begin
  // Åñëè îñòàíîâèëè çàïèñü è ñäåëàëè WaveInReset, òî âîçíèêàåò
  // ñòîëüêî ñîáûòèé OnWaveIn, ñêîëüêî áûëî áóôåðîâ â î÷åðåäè.
  // Ñîîáùåíèÿ ïðèõîäÿò óæå ïîñëå îñâîáîæäåíèÿ áóôåðîâ, ïîýòîìó, íåëüçÿ ê íèì îáðàùàòüñÿ.
  if stop then
    exit;
  h:=PaintBox1.Height;
  XScale:=PaintBox1.Width/BufSize;
 
    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));
 
 
  with PaintBox1.Canvas do begin
    Brush.Color:=clWhite;
    FillRect(ClipRect);
    Polyline(Slice(p^, BufSize));
  end;
 
  WaveInUnPrepareHeader(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr));
  WriteWaveBuffer(WaveF, PWaveHdr(Msg.lParam)^.lpData^, BufLen);
 
  WaveInPrepareHeader(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr));
  WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr));
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Bits:=16;
  Ch:=2;
  SampleFreq:=44100;
  ShowInfo;
  TrackBar1.OnChange:=CheckBox1Click;
  Button1.Caption:='Start';
  Button2.Caption:='Stop';
 
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2.Click;
end;
 
{  TWaveHeader = packed 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;{}
procedure TForm1.SaveWavFile(afreq, achans: Dword; FileName: string; Buffer: pointer; Size: Integer);
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:=Ch;
      Freq:=SampleFreq;
      BitsPerSample:=Bits;
      BlockAlign:=Ch*(Bits div 8);
      BytesPerSec:=SampleFreq*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;
 
function TForm1.CreateWaveFile(FileName: string; afreq, achans, abps: Dword): integer;
var
  header: TWaveHeader;
begin
  FWaveDataSize:=0;
  FillChar(header, SizeOf(header), 0);
  header.idRiff:='RIFF';
  header.idWave:='WAVE';
  header.idFmt:='fmt ';
  header.InfoLen:=16;
  header.FormatTag:=1;
  header.Channels:=Ch;
  header.Freq:=SampleFreq;
  header.BlockAlign:=(bits div 8)*Ch;
  header.BytesPerSec:=header.BlockAlign*SampleFreq;
 
  header.BitsPerSample:=bits;
  header.idData:='data';
 
  Result:=FileCreate(FileName);
  if Result<>INVALID_HANDLE_VALUE then
    FileWrite(Result, header, SizeOf(header));
end;
 
function TForm1.WriteWaveBuffer(F: integer; const Buffer; Count: integer): integer;
begin
  Result:=FileWrite(F, Buffer, Count);
  FWaveDataSize:=FWaveDataSize+Count;
end;
 
procedure TForm1.CloseWaveFile(F: integer);
var
  header: TWaveHeader;
begin
  FileSeek(F, 0, 0);
  FileRead(F, header, SizeOf(header));
  header.RiffLen:=SizeOf(header)-8+FWaveDataSize;
  header.DataBytes:=FWaveDataSize;
  FileSeek(F, 0, 0);
  FileWrite(F, header, SizeOf(header));
  FileClose(F);
end;
 
end.
Оно конечно пишет. Но с хрипами и со скоростью 2х. Уже 4 часа бьюсь над параметрами, ничего не могу подобрать. Может буферов надо 4 сделать? Я ведь уже 2 канала пытаюсь писать.
0
 Аватар для Vadim00311
1 / 1 / 0
Регистрация: 22.10.2016
Сообщений: 105
26.10.2020, 10:49  [ТС]
Напиши Атому в личку. Это он мне тогда помог неплохо
0
0 / 0 / 0
Регистрация: 25.10.2020
Сообщений: 2
26.10.2020, 15:58
Всем спасибо! Отбой тревоги, данный пример полностью рабочий. Просто не догадался покрутить TrackBar, он регулирует размер буфера )
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
26.10.2020, 15:58

Запись звука с микрофона и сохранение в файл
Необходимо создать программу, с помощью которой можно записывать звук формата wav. Фактически клон стандартной звукозаписи.

Запись звука в массив и в файл wav
Здравствуйте! Такой вопрос. Вот мне нужно записать звук по нажатию кнопки (пусть будет пробела) и занести записанное в массив по формату...

Запись звука с микрофона и сохранение его в файл
Как записать звук с микрофона и сохранить его в файл. Например: Нажимаю на кнопку &quot;Записать&quot;, запись начинается. Нажимаю на...

Запись с микрофона в формат .wav
Добрый день! Задача такая нужен диктофон, который записывал бы в формате *.wav. Изначально я пробовал так: procedure...

Запись звука с микрофона
Здравствуйте. Не получается записать звук с микрофона в файл используя библиотеку NAudio. Подскажите пожалуйста как это сделать. На форуме...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
29
Ответ Создать тему
Опции темы

Новые блоги и статьи
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
Как у меня протекала болезнь
zorxor 27.08.2026
Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .
Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему
kumehtar 26.08.2026
ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .
[EasyBuilder Pro] Памятка по разработке для панелей Weintek
ФедосеевПавел 26.08.2026
Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .
Модель по догадкам
anaschu 25.08.2026
Прошло две недели. Я уже рассказывал, как разговаривал с сотрудниками у сортировки и как понял, что главная ветка — не про приёмку, а про отбор. Но тогда я думал, что понял механику. На этой неделе я. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru