用delphi开发播放多媒体流的程序(100分)

我想做一个能够直接播放内存中多媒体数据流的程序，可是，不知道媒体的设备类型
应该怎样指定，也就是说，怎样把媒体的设备类型与要播放的媒体数据缓冲区联系起
来。如有知道，望不吝赐教！

gz

程序种资源包含wav,然后读如缓冲播放,和你说的一样么,如果是,呵呵, 我有源代码!!

to ailine:

能寄我一份吗？谢谢！
sn_ui@163.net

to ailine:

我也要一份，谢谢！

huyonghh@163.com

要添一些数据结构，然后调用api
{
File Name: AudioIO.PAS V 4.00
Created: 5-Oct-96 by John Mertus on the IBM PC
Revision #1: 5-Oct-22 by John Mertus
-John Mertus

Version 1.00 Initial Release

}

{
There are three Sound Components, the first is the base Component,
TAudioIO. This defines the sampling rates, buffers and some of the
common events.

The second component is AudioOut, which started just loops playing out
buffers.

The third component is AudioIN, which, when started, just loops filling
buffer with digital data.

See AudioIO.Hlp for detailed explaination.



}


{-----------------Unit-AudioOut-------------------John Mertus---Oct 96---}

Unit AudioIO;

{*************************************************************************}
Interface



uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, MMSystem, UAFDefs;

{ Could make this dynamic, but the effortdo
esn't seem worth it. }
Const
MAXBUFFERS = 4;

Type

{TBuffer Event is what is called when a buffer is need or is full }

TBufferEvent = Function(Buffer : pChar;
Var Size : Integer) : Boolean of Object;
PAudioIO = ^TAudioIO;
PAudioOut = ^TAudioOut;
PAudioIn = ^TAudioIn;

TCallBackWinOut = Class(TWinControl)
private
{ Private declarations }
AudioComponent : PAudioOut;

procedure BufferDone(var Msg: TMessage);
message MM_WOM_DONE;
procedure WaveOpen(var Msg: TMessage);
message MM_WOM_OPEN;
procedure WaveClose(var Msg: TMessage);
message MM_WOM_CLOSE;

protected
{ Protected declarations }

public
{ Public declarations }

published
{ Published declarations }

end;



TCallBackWinIn = Class(TWinControl)
private
{ Private declarations }
AudioComponent : PAudioIn;

procedure BufferFinished(var Msg: TMessage);
message MM_WIM_DATA;
procedure WaveOpenIn(var Msg: TMessage);
message MM_WIM_OPEN;
procedure WaveCloseIn(var Msg: TMessage);
message MM_WIM_CLOSE;

end;



{---------------------------TAudioIO Component-----------------------------}

TAudioIO = class(TComponent)
private
{ Private declarations }
FBufferSize : Integer;
{ Actual buffer used }
FRequestedBufferSize : Integer;
{ Buffer size requested }
FNumBuffers : Integer;
FPaused : Boolean;

FWaveFmtEx : TWaveFormatEx;
FonOpen : TNotifyEvent;
FonClose : TNotifyEvent;
FWaveDevice : DWord;
hWaveHeader : Array [0..MAXBUFFERS-1] of THANDLE;
WaveHdr : Array [0..MAXBUFFERS-1] of PWAVEHDR;
WaveBuffer : Array [0..MAXBUFFERS-1] of lpstr;
hWaveBuffer : Array [0..MAXBUFFERS-1] of THANDLE;
BufIndex : Integer;
ContinueProcessing : Boolean;
{ Set to TRUE to start FALSE to abort
after filled buffers aredo
ne }

{ Property Functions }
Procedure SetNumBuffers(Value : Integer);
Procedure SetBufferSize(Value : Integer);
Procedure SetFrameRate(Value : Integer);
Procedure SetStereo(Value : Boolean);
Procedure SetBits(Value : Word);
Function GetFrameRate : Integer;
Function GetStereo : Boolean;
Procedure MakeWaveFmtConsistent;

protected
{ Protected declarations }
Function InitWaveHeaders : Boolean;
Function AllocPCMBuffers : Boolean;
Function FreePCMBuffers : Boolean;
Function AllocWaveHeaders : Boolean;
Procedure FreeWaveHeaders;

public
{ Public declarations }
ErrorMessage : String;
Active : Boolean;
FilledBuffers,
QueuedBuffers,
ProcessedBuffers : Integer;

Constructor Create(AOwner: TComponent);
Override;
Destructor Destroy;
Override;
Procedure StopAtOnce;
Virtual;
Procedure StopGracefully;
Virtual;

published
{ Published declarations }
Property BufferSize : Integer read FBufferSize write SetBufferSize Default 8192;
Property NumBuffers : Integer read FNumBuffers write SetNumBuffers Default 4;
Property FrameRate : Integer read GetFrameRate Write SetFrameRate Default 22055;
Property Stereo : Boolean read GetStereo Write SetStereo Default False;
Property Quantization : Word Read FWaveFmtEx.wBitsPerSample Write SetBits Default 16;
Property WaveDevice : Dword Read FWaveDevice Write FWaveDevice Default WAVE_MAPPER;
Property OnStart : TNotifyEvent Read FOnOpen Write FOnOpen;
Property OnStop : TNotifyEvent Read FOnClose Write FOnClose;
end;



{---------------------------TAudioOut Component-----------------------------}


TAudioOut = Class(TAudioIO)
private
{ Private declarations }
WaveDeviceOpen : Boolean;
CallBackWin : TCallBackWinOut;
FOnFillBuffer : TBufferEvent;

Function QueueBuffer : Boolean;
Function ReadBuffer(Idx, N : Integer) : Boolean;
Virtual;
Procedure SetPaused(Value : Boolean);
Procedure CloseWaveDevice;
Virtual;
Function Setup(Var TS: TAudioOut) : Boolean;
Virtual;
Function StartIt : Boolean;

protected
{ Protected declarations }

public
{ Public declarations }
WaveHandle : HWaveOut;
{ Waveform output handle }

Function Start(Var TS : TAudioOut) : Boolean;
Procedure StopAtOnce;
Override;
Procedure StopGracefully;
Override;
Function ElapsedTime : Real;

published
{ Published declarations }
Property Paused : Boolean Read FPaused Write SetPaused Default FALSE;
Property OnFillBuffer : TBufferEvent Read FOnFillBuffer Write FOnFillBuffer;
end;



{---------------------------TAudioIn Component-----------------------------}


TAudioIn = Class(TAudioIO)
private
{ Private declarations }
WaveDeviceOpen : Boolean;
CallBackWin : TCallBackWinIn;
FOnBufferFilled : TBufferEvent;

Function QueueBuffer : Boolean;
Function ProcessBuffer(B : lpstr;
N : Integer) : Boolean;
Virtual;
Procedure CloseWaveDevice;
Virtual;
Function Setup(Var TS: TAudioIn) : Boolean;
Virtual;
Function StartIt : Boolean;

protected
{ Protected declarations }

public
{ Public declarations }
WaveHandle : HWaveOut;
{ Waveform output handle }
Function Start(Var TS : TAudioIn) : Boolean;
Procedure StopAtOnce;
Override;
Procedure StopGracefully;
Override;
Function ElapsedTime : Real;

published
{ Published declarations }
Property OnBufferFilled : TBufferEvent Read FOnBufferFilled Write FOnBufferFilled;
end;



procedure Register;

{*************************************************************************}

implementation

{$R *.res}

{---------------TWaveOutGetErrorText------------John Mertus Oct 96---}

Function TWaveOutGetErrorText(iErr : Integer) : String;

{ This just gets the error text assocated with the output error ierr. }
{ }
{**********************************************************************}
Var
ErrorMsgC : Array [0..255] of Char;

begin

waveOutGetErrorText(iErr,ErrorMsgC,Sizeof(ErrorMsgC));
Result := StrPas(ErrorMsgC);
end;


{---------------TWaveInGetErrorText------------John Mertus Oct 96---}

Function TWaveInGetErrorText(iErr : Integer) : String;

{ This just gets the error text assocated with the output error ierr. }
{ }
{**********************************************************************}
Var
ErrorMsgC : Array [0..255] of Char;

begin

waveInGetErrorText(iErr,ErrorMsgC,Sizeof(ErrorMsgC));
Result := StrPas(ErrorMsgC);
end;


procedure Register;
begin

RegisterComponents('Sound', [TAudioOut, TAudioIn]);
end;


{---------------SetBufferSize-------------------John Mertus Oct 96---}

Procedure TAudioIO.SetBufferSize(Value : Integer);

{ This just set the buffersize, making sure it is too small. }
{ }
{**********************************************************************}
begin

If (Value < 512) then
Value := 512;
{ make the wave buffer size a multiple of the block align... }
FRequestedBufferSize := Value;
MakeWaveFmtConsistent;
FreePCMBuffers;
AllocPCMBuffers;
end;


{---------------SetNumBuffers-------------------John Mertus Oct 96---}

Procedure TAudioIO.SetNumBuffers(Value : Integer);

{ This just set the numbers of buffers making sure it is between }
{ and MaxNumberBuffers }
{ }
{**********************************************************************}
begin

If (Value < 2) then
Value := 2;
If (Value > MAXBUFFERS) then
Value := MAXBUFFERS;
FNumBuffers := Value;
end;


{---------------SetStereo-----------------------John Mertus Oct 96---}

Procedure TAudioIO.SetStereo(Value : Boolean);

{ This just set the numbers of channels, True 2, false 1. }
{ }
{**********************************************************************}
begin

If Value then

FWaveFmtEx.nChannels := 2
else

FWaveFmtEx.nChannels := 1;
MakeWaveFmtConsistent;
end;


{---------------SetBits-------------------------John Mertus Oct 96---}

Procedure TAudioIO.SetBits(Value : Word);

{ This just set the numbers of buffers making sure it is between }
{ and MaxNumberBuffers }
{ }
{**********************************************************************}
begin

If (Value < 8) then
Value := 8;
If (Value > 8) then
Value := 16;
FWaveFmtEx.wBitsPerSample := Value;
MakeWaveFmtConsistent;
end;


{---------------SetFrameRate--------------------John Mertus Oct 96---}

Procedure TAudioIO.SetFrameRate(Value : Integer);

{ This just set the frame rate for sampling. }
{ }
{**********************************************************************}
begin

FWaveFmtEx.nSamplesPerSec := Value;
MakeWaveFmtConsistent;
end;


{---------------GetFrameRate--------------------John Mertus Oct 96---}

Function TAudioIO.GetFrameRate : Integer;

{ This just returns the framerate for the current header. }
{ }
{**********************************************************************}
begin

Result := FWaveFmtEx.nSamplesPerSec;
end;


{---------------GetStereo-----------------------John Mertus Oct 96---}

Function TAudioIO.GetStereo : Boolean;

{ This just returns the True if stereo, e.g. 2 channels }
{ }
{**********************************************************************}
begin

Result := (FWaveFmtEx.nChannels = 2);
end;



{-----------------Create------------------------John Mertus Oct 96---}

Constructor TAudioIO.Create(AOwner: TComponent);

{ This just set the numbers of buffers making sure it is between }
{ and MaxNumberBuffers }
{ }
{**********************************************************************}
Var
i : Integer;


begin

Inherited Create(AOwner);
FNumBuffers := 4;
FRequestedBufferSize := 8192;
Active := FALSE;
FPaused := FALSE;
FWaveDevice := WAVE_MAPPER;
ErrorMessage := '';

{ Set the indendent sampling rates }
FWaveFmtEx.wFormatTag := WAVE_FORMAT_PCM;
FWaveFmtEx.wBitsPerSample := 16;
FWaveFmtEx.nchannels := 1;
FWaveFmtEx.nSamplesPerSec := 22050;
MakeWaveFmtConsistent;

{ Now make sure we know buffers are not allocated }
For i := 0 to MAXBUFFERS-1do
WaveBuffer := Nil;

AllocWaveHeaders;
AllocPCMBuffers;
end;


{-----------------Destroy-----------------------John Mertus Oct 96---}

Destructor TAudioIO.Destroy;

{ This cleans up the buffers. }
{ }
{**********************************************************************}
begin

FreePCMBuffers;
FreeWaveHeaders;
Inherited Destroy;
end;


{-----------------MakeWaveFmtConsistent---------John Mertus Oct 96---}

Procedure TAudioIO.MakeWaveFmtConsistent;

{ This just trys to find the correct avgbytes and blockalign that }
{ one needs to use for the format. Ido
NOT UNDERSTAND WHY MICROSOFT }
{ did this. }
{ }
{**********************************************************************}
begin

With FWaveFmtExdo

begin

nBlockAlign := (wBitsPerSample div 8)*nchannels;
nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
end;


FBufferSize := FRequestedBufferSize - (FRequestedBufferSize mod FWaveFmtEx.nBlockAlign);
end;


{-------------InitWaveHeaders----------------John Mertus---14-June--97--}

Function TAudioIO.InitWaveHeaders : Boolean;

{ This just initalizes the waveform headers, no memory allocated }
{ }
{**********************************************************************}
Var
i : Integer;

begin

{ This should not be necessary, but to be safe... }
MakeWaveFmtConsistent;

{ Set the wave headers }
For i := 0 to FNumBuffers-1do

With WaveHdr^do

begin

lpData := WaveBuffer;
// address of the waveform buffer
dwBufferLength := FBufferSize;
// length, in bytes, of the buffer
dwBytesRecorded := 0;
// see below
dwUser := 0;
// 32 bits of user data
dwFlags := 0;
// see below
dwLoops := 0;
// see below
lpNext := Nil;
// reserved;
must be zero
reserved := 0;
// reserved;
must be zero
end;


InitWaveHeaders := TRUE;
end;



{-------------AllocPCMBuffers----------------John Mertus---14-June--97--}

Function TAudioIO.AllocPCMBuffers : Boolean;

{ Allocate and lock the waveform memory. }
{ }
{***********************************************************************}
Var
i : Integer;

begin

For i := 0 to fNumBuffers-1do

begin

hWaveBuffer := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize );
If (hWaveBuffer = 0) then

begin

FreePCMBuffers;
ErrorMessage := 'Error allocating wave buffer memory';
AllocPCMBuffers := False;
Exit;
end;


WaveBuffer := GlobalLock(hWaveBuffer);
If (WaveBuffer = Nil) then

begin

FreePCMBuffers;
ErrorMessage := 'Error Locking wave buffer memory';
AllocPCMBuffers := False;
Exit;
end;

WaveHdr.lpData := WaveBuffer;
end;


AllocPCMBuffers := TRUE;
end;


{--------------FreePCMBuffers----------------John Mertus---14-June--97--}

Function TAudioIO.FreePCMBuffers : Boolean;

{ Free up the meomry AllocPCMBuffers used. }
{ }
{***********************************************************************}
Var
i : Integer;

begin


Result := FALSE;

For i := 0 to MaxBuffers-1do

begin

If (hWaveBuffer <> 0) then

begin

GlobalUnlock(hWaveBuffer );
GlobalFree(hWaveBuffer );
hWaveBuffer := 0;
WaveBuffer := Nil;
Result := TRUE;
end;

end;


end;

{-------------AllocWaveHeaders---------------John Mertus---14-June--97--}

Function TAudioIO.AllocWaveHeaders : Boolean;

{ Allocate and lock header memory }
{ }
{***********************************************************************}
Var
i : Integer;

begin

For i := 0 to MAXBUFFERS-1do

begin

hwaveheader := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, sizeof(TWAVEHDR));
if (hwaveheader = 0) then

begin

FreeWaveHeaders;
ErrorMessage := 'Error allocating wave header memory';
AllocWaveHeaders := FALSE;
Exit;
end;


WaveHdr := GlobalLock (hwaveheader);
If (WaveHdr = Nil ) then

begin

FreeWaveHeaders;
ErrorMessage := 'Could not lock header memory for recording';
AllocWaveHeaders := FALSE;
Exit;
end;


end;


AllocWaveHeaders := TRUE;
end;


{---------------FreeWaveHeaders---------------John Mertus---14-June--97--}

Procedure TAudioIO.FreeWaveHeaders;

{ Just free up the memory AllocWaveHeaders allocated. }
{ }
{***********************************************************************}
Var
i : Integer;

begin

For i := 0 to MAXBUFFERS-1do

begin

If (hWaveHeader <> 0) then

begin

GlobalUnlock(hwaveheader);
GlobalFree(hwaveheader);
hWaveHeader := 0;
WaveHdr := Nil;
End
end;

end;


{--------------------StopAtOnce-------------John Mertus---14-June--97--}

Procedure TAudioIO.StopAtOnce;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

Active := False;
ContinueProcessing := FALSE;
end;


{--------------------StopGracefully---------John Mertus---14-June--97--}

Procedure TAudioIO.StopGracefully;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

ContinueProcessing := FALSE;
end;


{-----------------ElapsedTime----------------John Mertus---14-June--97--}

Function TAudioOut.ElapsedTime : Real;

{ This function returns the time since start of playout. }
{ }
{**********************************************************************}
Var
pmmt : TMMTime;

begin

If (Active) then

begin

pmmt.wType := TIME_SAMPLES;
If (waveOutGetPosition(WaveHandle, @pmmt, Sizeof(TMMTime)) <> 0) then

Result := 0
else

Result := pmmt.Sample/FrameRate;
End
else

Result := 0;
end;


{---------------SetPaused-----------------------John Mertus Oct 96---}

Procedure TAudioOut.SetPaused(Value : Boolean);

{ This pauses or restarts the output. }
{ }
{**********************************************************************}
begin

FPaused := Value;
If (Not Active) then
Exit;
If FPaused then

WaveOutPause(WaveHandle)
else

WaveOutReStart(WaveHandle);
end;


{-------------CloseWaveDevice----------------John Mertus---14-June--97--}

Procedure TAudioOut.CloseWaveDevice;

{ Closes the wave output device. }
{ }
{**********************************************************************}
Var
i : Integer;

begin

{ unprepare the headers }
Active := FALSE;
Paused := FALSE;
For i := 0 to FNumBuffers-1do

waveOutUnprepareHeader( WaveHandle, WaveHdr, sizeof(TWAVEHDR));

{ close the device }
waveOutClose(WaveHandle);
WaveDeviceOpen := FALSE;

end;


{-------------SetupOutput--------------------John Mertus---14-June--97--}

Function TAudioOut.Setup(Var TS : TAudioOut) : Boolean;

{ This function just sets up the board for output. }
{ }
{**********************************************************************}
Var
iErr : Integer;
i : Integer;

begin


{ if the device is still open, return error }
If (WaveDeviceOpen) then

begin

ErrorMessage := 'Wave output device is already open';
Result := FALSE;
Exit;
end;


BufIndex := 0;

{ Now create the window component to handle the processing }
CallBackWin := TCallBackWinOut.CreateParented(TWinControl(Owner).Handle);
CallBackWin.Visible := FALSE;
CallBackWin.AudioComponent := @TS;

{ Open the device for playout }
{ Either go via interrupt or window }
iErr := WaveOutOpen(@WaveHandle, FWaveDevice, @FWaveFmtEx, Integer(CallBackWin.Handle),
0, CALLBACK_WINDOW or WAVE_ALLOWSYNC );

If (iErr <> 0) then

begin

ErrorMessage := TWaveOutGetErrorText(iErr);
Result := FALSE;
Exit;
end;


WaveDeviceOpen := TRUE;

{ Setup the buffers and headers }
If (Not InitWaveHeaders) then

begin

Result := FALSE;
Exit;
end;


{ Now Prepare the buffers for output }
For i := 0 to FNumBuffers-1do

begin

iErr := WaveOutPrepareHeader(WaveHandle, WaveHdr, sizeof(TWAVEHDR));
If (iErr <> 0) then

begin

ErrorMessage := TWaveOutGetErrorText(iErr);
CloseWaveDevice;
Result := FALSE;
Exit;
end;

end;


{ Read in the buffers }
QueuedBuffers := 0;
ProcessedBuffers := 0;
FilledBuffers := 0;
ContinueProcessing := TRUE;
Active := TRUE;

If (Not ReadBuffer(0, FBufferSize)) then

begin

CloseWaveDevice;
ErrorMessage := 'There must be at least one filled buffer';
Result := FALSE;
Exit;
end;


For i := 1 to FNumBuffers - 1do
ReadBuffer(i, FBufferSize);

Result := TRUE;
end;


{----------------QueueBuffer----------------John Mertus---14-June--97--}

Function TAudioOut.QueueBuffer : Boolean;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
Var
iErr : Integer;

begin

{ reset flags field (remove WHDR_DONE attribute) }
WaveHdr[bufindex].dwFlags := WHDR_PREPARED;

{ now queue the buffer for output }
iErr := waveOutWrite( WaveHandle, WaveHdr[bufindex], sizeof(TWAVEHDR));
If (iErr <> 0) then

begin

ErrorMessage := TwaveOutGetErrorText(iErr);
StopGracefully;
Result := FALSE;
Exit;
end;


{ Advance index }
bufindex := (bufindex+1) mod FNumBuffers;

Result := TRUE;
end;


{-------------StartIt------------------------John Mertus---14-June--97--}

Function TAudioOut.StartIt : Boolean;

{ This function just starts the waveform playing }
{ }
{**********************************************************************}
Var
i : Integer;

begin

Active := TRUE;

If (FPaused) then
WaveOutPause(WaveHandle);
{ Now we are ready to start the output }
If (Not QueueBuffer) then

begin

CloseWaveDevice;
Result := FALSE;
Exit;
end;


For i := 0 to FNumBuffers - 2do
QueueBuffer;
Result := TRUE;
end;


{-----------------Start----------------------John Mertus---14-June--97--}

Function TAudioOut.Start(Var TS : TAudioOut) : Boolean;

{ This function first sets up the output and then
starts it. }
{ }
{**********************************************************************}
begin

Result := Setup(TS);
If (Not Result) then
Exit;

Result := StartIt;
If (Not Result) then
Exit;
end;



{-------------ReadBuffer---------------------John Mertus---14-June--97--}

Function TAudioOut.ReadBuffer(Idx, N : Integer) : Boolean;

{ This is called whenver move buffer data is needed. }
{ }
{**********************************************************************}
Var
NSize : Integer;

begin

{do
not call the read buffer routine if we want to stop }
If (Not ContinueProcessing) then

begin

Result := FALSE;
Exit;
end;


{ If assigned, process the buffer, Notice that the Size returned may not
be the size sent, so reset the output size }
If Assigned(FOnFillBuffer) then

begin

NSize := N;
Result := FOnFillBuffer(WaveBuffer[idx], NSize);
WaveHdr[idx].dwBufferLength := NSize;
End
else

Result := FALSE;

{ On a filled buffer, increment it }
If (Result) then
FilledBuffers := FilledBuffers + 1;
QueuedBuffers := FilledBuffers - ProcessedBuffers;
end;


{--------------------StopAtOnce-------------John Mertus---14-June--97--}

Procedure TAudioOut.StopAtOnce;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

{ if the device isn't open, just return }
If (Not WaveDeviceOpen) then
Exit;

Active := False;
ContinueProcessing := FALSE;

{ stop playing }
waveOutReset(WaveHandle);

{ close the device and unprepare the headers }
CloseWaveDevice;
end;


{--------------------StopGracefully---------John Mertus---14-June--97--}

Procedure TAudioOut.StopGracefully;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

{ if the device isn't open, just return }
If (Not WaveDeviceOpen) then
Exit;
ContinueProcessing := FALSE;
end;


{------------------BufferDone---------------John Mertus---14-June--97--}

Procedure TCallBackWinOut.BufferDone(Var Msg : TMessage);

{ This is called when a buffer sido
ne playing }
{ }
{**********************************************************************}
begin

With AudioComponent^do

begin

ProcessedBuffers := ProcessedBuffers + 1;
QueuedBuffers := FilledBuffers - ProcessedBuffers;
Active := (QueuedBuffers > 0);
If (ReadBuffer(BufIndex, FBufferSize)) then
QueueBuffer;

If (Not Active) then

begin

ContinueProcessing := FALSE;
CloseWaveDevice;
end;


end;

end;


{------------------WaveOpen-----------------John Mertus---14-June--97--}

Procedure TCallBackWinOut.WaveOpen(Var Msg : TMessage);

{ This is called at the termination of each buffer. }
{ }
{**********************************************************************}
begin

If Assigned(AudioComponent.FonOpen) then
AudioComponent.FonOpen(Self);
end;



{------------------WaveClose----------------John Mertus---14-June--97--}

Procedure TCallBackWinOut.WaveClose(Var Msg : TMessage);

{ This is called at the termination of each buffer. }
{ }
{**********************************************************************}
begin

If Assigned(AudioComponent.FonClose) then
AudioComponent.FonClose(Self);
end;


{-----------------ElapsedTime----------------John Mertus---14-June--97--}

Function TAudioIn.ElapsedTime : Real;

{ This function returns the time since start of playout. }
{ }
{**********************************************************************}
Var
pmmt : TMMTime;

begin

If (Active) then

begin

pmmt.wType := TIME_SAMPLES;
If (waveInGetPosition(WaveHandle, @pmmt, Sizeof(TMMTime)) <> 0) then

Result := 0
else

Result := pmmt.sample/FrameRate;
End
else

Result := 0;
end;


{-------------CloseWaveDevice----------------John Mertus---14-June--97--}

Procedure TAudioIn.CloseWaveDevice;

{ Closes the wave output device. }
{ }
{**********************************************************************}
Var
i : Integer;

begin

{ unprepare the headers }
Active := FALSE;
For i := 0 to FNumBuffers-1do

waveInUnprepareHeader( WaveHandle, WaveHdr, sizeof(TWAVEHDR));

{ close the device }
waveInReset(WaveHandle);
waveInClose(WaveHandle);
WaveDeviceOpen := FALSE;

end;


{-------------SetupOutput--------------------John Mertus---14-June--97--}

Function TAudioIn.Setup(Var TS : TAudioIn) : Boolean;

{ This function just sets up the board for output. }
{ }
{**********************************************************************}
Var
iErr : Integer;
i : Integer;

begin


{ if the device is still open, return error }
If (WaveDeviceOpen) then

begin

ErrorMessage := 'Wave Input device is already open';
Result := FALSE;
Exit;
end;


BufIndex := 0;

{ Now create the window component to handle the processing }
CallBackWin := TCallBackWinIn.CreateParented(TWinControl(Owner).Handle);
CallBackWin.Visible := FALSE;
CallBackWin.AudioComponent := @TS;

{ Open the device for playout }
{ Either go via interrupt or window }
iErr := WaveInOpen(@WaveHandle, FWaveDevice, @FWaveFmtEx, Integer(CallBackWin.Handle),
0, CALLBACK_WINDOW or WAVE_ALLOWSYNC );

If (iErr <> 0) then

begin

ErrorMessage := TWaveInGetErrorText(iErr);
Result := FALSE;
Exit;
end;


WaveDeviceOpen := TRUE;

{ Setup the buffers and headers }
If (Not InitWaveHeaders) then

begin

Result := FALSE;
Exit;
end;


{ Now Prepare the buffers for output }
For i := 0 to FNumBuffers-1do

begin

iErr := WaveInPrepareHeader(WaveHandle, WaveHdr, sizeof(TWAVEHDR));
If (iErr <> 0) then

begin

ErrorMessage := TWaveInGetErrorText(iErr);
CloseWaveDevice;
Result := FALSE;
Exit;
end;

end;


{ Read in the buffers }
QueuedBuffers := 0;
ProcessedBuffers := 0;
FilledBuffers := 0;
ContinueProcessing := TRUE;
Active := TRUE;

Result := TRUE;
end;


{----------------QueueBuffer----------------John Mertus---14-June--97--}

Function TAudioIn.QueueBuffer : Boolean;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
Var
iErr : Integer;

begin

{ reset flags field (remove WHDR_DONE attribute) }
WaveHdr[bufindex].dwFlags := WHDR_PREPARED;

{ now queue the buffer for output }
iErr := waveInAddBuffer( WaveHandle, WaveHdr[bufindex], sizeof(TWAVEHDR));
If (iErr <> 0) then

begin

ErrorMessage := TWaveInGetErrorText(iErr);
StopGracefully;
Result := FALSE;
Exit;
end;


{ Advance index }
bufindex := (bufindex+1) mod FNumBuffers;
QueuedBuffers := QueuedBuffers + 1;

Result := TRUE;
end;


{-------------StartIt------------------------John Mertus---14-June--97--}

Function TAudioIn.StartIt : Boolean;

{ This function just starts the waveform playing }
{ }
{**********************************************************************}
Var
i, iErr : Integer;

begin

{ start recording to first buffer }
iErr := WaveInStart(WaveHandle);
If (iErr <> 0) then

begin

CloseWaveDevice;
ErrorMessage := 'Error starting wave record: ' + TWaveInGetErrorText(iErr);
Result := FALSE;
Exit;
end;


Active := TRUE;

{ Now we are ready to start the output }
For i := 0 to FNumBuffers - 1do

If (Not QueueBuffer) then

begin

CloseWaveDevice;
Result := FALSE;
Exit;
end;


Result := TRUE;
end;


{-----------------Start----------------------John Mertus---14-June--97--}

Function TAudioIn.Start(Var TS : TAudioIn) : Boolean;

{ This function first sets up the output and then
starts it. }
{ }
{**********************************************************************}
begin

Result := Setup(TS);
If (Not Result) then
Exit;

Result := StartIt;
If (Not Result) then
Exit;
end;



{-----------ProcessBuffer---------------------John Mertus---14-June--97--}

Function TAudioIn.ProcessBuffer(B : lpstr;
N : Integer) : Boolean;

{ This is called whenver move buffer data is needed. }
{ }
{**********************************************************************}

begin

{do
not call the read buffer routine if we want to stop }
If (Not ContinueProcessing) then

begin

Result := FALSE;
Exit;
end;


{ N can change, but wedo
nt' care }
If Assigned(FOnBufferFilled) then

begin

Result := FOnBufferFilled(B, N);
End
else

Result := TRUE;

{ On a filled buffer, increment it }
If (Result) then
FilledBuffers := FilledBuffers + 1;
end;


{--------------------StopAtOnce-------------John Mertus---14-June--97--}

Procedure TAudioIn.StopAtOnce;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

{ if the device isn't open, just return }
If (Not WaveDeviceOpen) then
Exit;

Active := False;
ContinueProcessing := FALSE;

{ stop playing }
waveInReset(WaveHandle);

{ close the device and unprepare the headers }
CloseWaveDevice;
end;


{--------------------StopGracefully---------John Mertus---14-June--97--}

Procedure TAudioIn.StopGracefully;

{ Write the buffer to the wave device and toggel buffer index. }
{ }
{**********************************************************************}
begin

{ if the device isn't open, just return }
If (Not WaveDeviceOpen) then
Exit;
ContinueProcessing := FALSE;
end;


{------------------BufferFinished-----------John Mertus---14-June--97--}

Procedure TCallBackWinIn.BufferFinished(Var Msg : TMessage);

{ This is called when each buffer is filled. }
{ }
{**********************************************************************}
begin

With AudioComponent^do

begin

ProcessedBuffers := ProcessedBuffers + 1;
QueuedBuffers := QueuedBuffers - 1;
Active := (QueuedBuffers > 0);
If (ProcessBuffer(WaveBuffer[BufIndex], FBufferSize)) then
QueueBuffer;

If (Not Active) then

begin

ContinueProcessing := FALSE;
CloseWaveDevice;
end;


end;

end;


{------------------WaveOpenIn---------------John Mertus---14-June--97--}

Procedure TCallBackWinIn.WaveOpenIn(Var Msg : TMessage);

{ This is called at the termination of each buffer. }
{ }
{**********************************************************************}
begin

If Assigned(AudioComponent.FonOpen) then
AudioComponent.FonOpen(Self);
end;



{------------------WaveCloseIn----------------John Mertus---14-June--97--}

Procedure TCallBackWinIn.WaveCloseIn(Var Msg : TMessage);

{ This is called at the termination of each buffer. }
{ }
{**********************************************************************}
begin

If Assigned(AudioComponent.FonClose) then
AudioComponent.FonClose(Self);
end;



end.

關注

以上似乎不是很好,看看这里吧
http://www.delphibbs.com/delphibbs/dispq.asp?lid=886191
或
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1181350

http://www.138soft.com/htm/voddemo.zip