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

@Vadim00311 · Регистрация: 22.10.2016

Студворк — интернет-сервис помощи студентам

Здравствуйте друзья! Думаю многим начинающим программистам 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.

@AzAtom · 23.05.2019, 16:33

Vadim00311, вот нашлась тема по этому поводу. Если нужны 1 байтовые символы, то в Delphi XE2 нужно использовать не char, а ansichar. Думаю, и здесь так же.

Delphi XE2 тип Char

@Vadim00311 · 23.05.2019, 16:42 **[ТС]**

Да, у меня Char по 2 байта

Добавлено через 1 минуту
Получается мне везде char нужно заменить на ansichar?

@AzAtom · 23.05.2019, 16:46

Да, во всех 4 местах в определении записи TWaveHeader.

@Vadim00311 · 23.05.2019, 17:05 **[ТС]**

Атом, ты красавчик! Спасибо тебе! Все работает.))))

@Vadim00311 · 23.05.2019, 23:45 **[ТС]**

Спасибо Атом! Ты мне очень помог дружище. Теперь сам попробую разобраться в коде)

@AzAtom · 24.05.2019, 09:41

Несколько уточнений. Ты Callback сделал по сообщению, это довольно удобно, но сообщения могут запаздывать. Например, если нажать мышкой на заголовок окна, то сообщения не будут приходить 1 секунду, за это время буферы для записи закончатся и будет пропуск.

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

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

@Alex7delta · 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 канала пытаюсь писать.

@Vadim00311 · 26.10.2020, 10:49 **[ТС]**

Напиши Атому в личку. Это он мне тогда помог неплохо

@Alex7delta · 26.10.2020, 15:58

Всем спасибо! Отбой тревоги, данный пример полностью рабочий. Просто не догадался покрутить TrackBar, он регулирует размер буфера )

Новые блоги и статьи Все статьи Все блоги /
20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .	"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.
Использование TThread в Lazarus для математических вычислений. Massaraksh7 25.05.2026 Производя рефакторинг своих программ на предмет ускорения их работы, обратил внимание на такой аспект, как сокращение времени матвычислений. Дело в том, что приходится работать с большими матрицами. . .	Модель здравосохранения 18. Чем здоровее работник, тем быстрее выгорает anaschu 24.05.2026 Имитационная модель корпоративного здравоохранения: что показывает математика Сегодня в модели рабочего коллектива на AnyLogic появились три новые механики — выгорание через накопленную усталость,. . .	Модель здравосохранения 17. Планы на выгорание anaschu 23.05.2026 Вот конкретная схема реализации: В классе Работник добавить: накопленнаяУсталость — растёт каждый час работы, снижается в перерывы и болезни коэффициентПрезентеизма — снижает продуктивность. . .	Изменение цветов в палитре gif файла aka фавикона russiannick 23.05.2026 Изменение цветов в палитре gif файла, юзаемого как фавиконка в составе html-файла, помещенная в base64, средствами нативного Java Script, навеянное сном в майский день. Для работы необходим браузер,. . .

@AzAtom Модератор 4150 / 2360 / 813 Регистрация: 15.11.2015 Сообщений: 9,490
	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

@AzAtom Модератор 4150 / 2360 / 813 Регистрация: 15.11.2015 Сообщений: 9,490
	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

@AzAtom Модератор 4150 / 2360 / 813 Регистрация: 15.11.2015 Сообщений: 9,490
	24.05.2019, 09:41
	Несколько уточнений. Ты Callback сделал по сообщению, это довольно удобно, но сообщения могут запаздывать. Например, если нажать мышкой на заголовок окна, то сообщения не будут приходить 1 секунду, за это время буферы для записи закончатся и будет пропуск. Возможно лучше использовать не сообщения, а callback функцию (CALLBACK_FUNCTION), которую драйвер будет вызывать непосредственно. В этом случае пропусков не будет. В эту функцию так же передаётся адрес освободившегося буфера. Ещё неплохо использовать CALLBACK_EVENT, но для этого лучше создать отдельный поток. И ещё нужно самому искать освободившийся буфер, проверяя флаги. 0

@Vadim00311 1 / 1 / 0 Регистрация: 22.10.2016 Сообщений: 105
	26.10.2020, 10:49 [ТС]
	Напиши Атому в личку. Это он мне тогда помог неплохо 0

@Alex7delta 0 / 0 / 0 Регистрация: 25.10.2020 Сообщений: 2
	26.10.2020, 15:58
	Всем спасибо! Отбой тревоги, данный пример полностью рабочий. Просто не догадался покрутить TrackBar, он регулирует размер буфера ) 0