Как записать звук с микрофона в WAV? -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [18.224.61.12]

Модераторы: Rouse_, jack128, Krid

Как записать звук с микрофона в WAV?

Vit

Сообщ. #1 , 07.11.03, 18:51

Guru

Профиль · PM

Поощрения: 16 Dgm

Рейтинг (т): 181

Вот короче это прям с рабочей проги взято...

{============================ Бегин ============================}

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;

Timer1: TTimer;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormDestroy(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;

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;

end.

{============================ END ============================}

Автор Fros

1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0170 ] [ 15 queries used ] [ Generated: 20.05.24, 23:49 GMT ]