给你个网上找的声音API
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,MMSystem, ComCtrls, ExtCtrls, StdCtrls, Audio;
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;
CheckBox1: TCheckBox;
PaintBox1: TPaintBox;
TrackBar1: TTrackBar;
Button3: TButton;
Audio1: TAudio;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
ms:TMemoryStream;
NoOfLoops : byte;
procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA; // = $3C0;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
WaveIn: hWaveIn;
hBuf: THandle;
BufHead: TWaveHdr;
bufsize: integer;
Bits16: boolean;
p: PPointArr;
stop: boolean = false;
{ TForm1 }
procedure TForm1.OnWaveIn(var Msg: TMessage);
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^ := Point(round(i * XScale), round(h / 2 - data16^ * YScale));
MS.Write(p^,1280);
end else begin
Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
YScale := h / (1 shl 8 );
for i := 0 to BufSize - 1 do
p^ := Point(round(i * XScale), round(h - data8^ * YScale));
MS.Write(p^,1280);
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.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
ms.Clear ;
ms.Position ;
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.CheckBox1Click(Sender: TObject);
begin
if stop then begin
Button2.Click;
Button1.Click;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ms.Free ;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ms:=TMemoryStream.Create ;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Audio1.Player.Play(ms,nil,NoOfLoops);
end;
end.
