564 lines
15 KiB
ObjectPascal
564 lines
15 KiB
ObjectPascal
(*
|
|
this file is a part of audio components suite v 2.3.
|
|
copyright (c) 2002-2005 andrei borovsky. all rights reserved.
|
|
see the license file for more details.
|
|
you can contact me at mail@z0m3ie.de
|
|
*)
|
|
|
|
{
|
|
$Log: acs_dxaudio.pas,v $
|
|
Revision 1.7 2006/08/31 20:10:56 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.6 2006/07/09 16:40:35 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.5 2006/07/04 17:12:45 z0m3ie
|
|
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
|
|
|
|
Revision 1.3 2006/01/01 18:46:40 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.2 2005/12/26 17:31:39 z0m3ie
|
|
fixed some problems in acs_dsfiles
|
|
fixed some problems in acs_vorbis
|
|
reworked all buffers
|
|
|
|
Revision 1.1 2005/12/19 18:36:05 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.9 2005/12/18 17:01:54 z0m3ie
|
|
delphi compatibility
|
|
|
|
Revision 1.8 2005/12/04 16:54:34 z0m3ie
|
|
All classes are renamed, Style TACS... than T... to avoid conflicts with other components (eg TMixer is TACSMixer now)
|
|
|
|
Revision 1.7 2005/10/02 16:51:31 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.6 2005/09/23 14:04:58 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.5 2005/09/18 19:28:59 z0m3ie
|
|
more progress on driver handling
|
|
|
|
Revision 1.4 2005/09/16 17:34:29 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.3 2005/09/15 20:59:38 z0m3ie
|
|
start translate the documentation in the source for pasdoc
|
|
|
|
Revision 1.2 2005/09/14 21:19:37 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.1 2005/09/13 21:53:45 z0m3ie
|
|
maked seperat driver (not complete jet)
|
|
|
|
Revision 1.1 2005/09/12 22:04:52 z0m3ie
|
|
modified structure again, fileformats are now in an sperat folder.
|
|
all File In/Out classes are capsulated from TFileIn and TFileOut
|
|
|
|
Revision 1.1 2005/08/25 20:18:00 z0m3ie
|
|
Version 2.4 restructure
|
|
TCDPlayer removed (fits not in component structure)
|
|
TMP3ToWavConverter removed (fits not in component structure)
|
|
|
|
Revision 1.3 2005/08/22 20:17:02 z0m3ie
|
|
changed Headers to log
|
|
changed mail adress
|
|
|
|
}
|
|
|
|
{$ifdef linux}{$message error 'unit not supported'}{$endif linux}
|
|
|
|
unit acs_dxaudio;
|
|
|
|
interface
|
|
|
|
uses
|
|
ACS_Audio,SysUtils, Classes, Forms, ACS_Types, ACS_Classes, Windows,ACS_Strings;
|
|
|
|
const
|
|
LATENCY = 25;
|
|
DS_POLLING_INTERVAL = 400; //milliseconds
|
|
|
|
type
|
|
|
|
TDSoundWrapper = record
|
|
dsw_pDirectSound : Pointer;
|
|
dsw_OutputBuffer : Pointer;
|
|
dsw_WriteOffset : LongWord;
|
|
dsw_OutputSize : Integer;
|
|
dsw_BytesPerFrame : Integer;
|
|
dsw_CounterTicksPerBuffer : Int64;
|
|
dsw_LastPlayTime : Int64;
|
|
dsw_LastPlayCursor : Int64;
|
|
dsw_OutputUnderflows : Int64;
|
|
dsw_OutputRunning : LongBool;
|
|
dsw_FramesWritten : Double;
|
|
dsw_FramesPlayed : Double;
|
|
dsw_pDirectSoundCapture : Pointer;
|
|
dsw_InputBuffer : Pointer;
|
|
dsw_ReadOffset : LongWord;
|
|
dsw_InputSize : LongWord;
|
|
end;
|
|
|
|
PDSoundWrapper = ^TDSoundWrapper;
|
|
|
|
TDSW_DeviceInfo = record
|
|
guid : TGUID;
|
|
name : array[0..127] of char;
|
|
end;
|
|
|
|
TDSW_Devices = record
|
|
devcount : Integer;
|
|
dinfo : array [0..15] of TDSW_DeviceInfo;
|
|
end;
|
|
|
|
PDSW_Devices = ^TDSW_Devices;
|
|
|
|
{ TDXAudioOut }
|
|
|
|
TDXAudioOut = class(TACSBaseAudioOut)
|
|
private
|
|
DSW : TDSoundWrapper;
|
|
Devices : TDSW_Devices;
|
|
Chan, SR, BPS : Integer;
|
|
EndOfInput, StartInput : Boolean;
|
|
FDeviceNumber : Integer;
|
|
FDeviceCount : Integer;
|
|
procedure SetDevice(Ch : Integer);override;
|
|
function GetDeviceInfo : TACSDeviceInfo;override;
|
|
function GetDeviceCount : Integer;override;
|
|
protected
|
|
procedure Done; override;
|
|
function DoOutput(Abort : Boolean):Boolean; override;
|
|
procedure Prepare; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Pause;override;
|
|
procedure Resume;override;
|
|
end;
|
|
|
|
TDXAudioIn = class(TACSBaseAudioIn)
|
|
private
|
|
DSW : TDSoundWrapper;
|
|
Devices : TDSW_Devices;
|
|
FDeviceNumber : Integer;
|
|
FDeviceCount : Integer;
|
|
FBPS, FChan, FFreq : Integer;
|
|
FOpened : Integer;
|
|
FBytesToRead : Integer;
|
|
FRecTime : Integer;
|
|
procedure SetDevice(i : Integer);override;
|
|
function GetDeviceName(Number : Integer) : String;
|
|
procedure OpenAudio;
|
|
procedure CloseAudio;
|
|
function GetBPS : Integer; override;
|
|
function GetCh : Integer; override;
|
|
function GetSR : Integer; override;
|
|
function GetTotalTime : real; override;
|
|
procedure SetRecTime(aRecTime : Integer);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetData(Buffer : Pointer; BufferSize : Integer): Integer; override;
|
|
procedure Init; override;
|
|
procedure Flush; override;
|
|
property DeviceCount : Integer read FDeviceCount;
|
|
property DeviceName[Number : Integer] : String read GetDeviceName;
|
|
end;
|
|
|
|
implementation
|
|
|
|
type
|
|
|
|
DSW_Init_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_Term_t = procedure(dsw: PDSoundWrapper); cdecl;
|
|
DSW_InitOutputDevice_t = function (dsw: PDSoundWrapper; const guid : TGUID) : HRESULT; cdecl;
|
|
DSW_InitOutputBuffer_t = function (dsw: PDSoundWrapper; Wnd : HWND; bps, nFrameRate : LongWord; nChannels, bufSize : Integer): HRESULT; cdecl;
|
|
DSW_StartOutput_t = function (dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_StopOutput_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_RestartOutput_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_GetOutputStatus_t = function(dsw: PDSoundWrapper) : DWORD; cdecl;
|
|
DSW_WriteBlock_t = function(dsw: PDSoundWrapper; buf : PByte; numBytes : Integer) : HRESULT; cdecl;
|
|
DSW_ZeroEmptySpace_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_QueryOutputSpace_t = function(dsw: PDSoundWrapper; var bytesEmpty ) : HRESULT; cdecl;
|
|
DSW_Enumerate_t = function(var devices : TDSW_Devices) : HRESULT; cdecl;
|
|
|
|
DSW_InitInputBuffer_t = function(dsw: PDSoundWrapper; bps, nFrameRate, nChannels, bufSize : Integer) : HRESULT; cdecl;
|
|
DSW_InitInputDevice_t = function(dsw: PDSoundWrapper; const GUID : TGUID) : HRESULT; cdecl;
|
|
DSW_StartInput_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_StopInput_t = function(dsw: PDSoundWrapper) : HRESULT; cdecl;
|
|
DSW_ReadBlock_t = function(dsw: PDSoundWrapper; buf : PByte; numBytes : Integer) : HRESULT; cdecl;
|
|
DSW_QueryInputFilled_t = function(dsw: PDSoundWrapper; var bytesFilled : Integer) : HRESULT; cdecl;
|
|
|
|
var
|
|
|
|
LibdswLoaded : Boolean = False;
|
|
|
|
DSW_Init : DSW_Init_t;
|
|
DSW_Term : DSW_Term_t;
|
|
DSW_InitOutputDevice : DSW_InitOutputDevice_t;
|
|
DSW_InitOutputBuffer : DSW_InitOutputBuffer_t;
|
|
DSW_StartOutput : DSW_StartOutput_t;
|
|
DSW_StopOutput : DSW_StopOutput_t;
|
|
DSW_RestartOutput : DSW_RestartOutput_t;
|
|
DSW_GetOutputStatus : DSW_GetOutputStatus_t;
|
|
DSW_WriteBlock : DSW_WriteBlock_t;
|
|
DSW_ZeroEmptySpace : DSW_ZeroEmptySpace_t;
|
|
DSW_QueryOutputSpace : DSW_QueryOutputSpace_t;
|
|
DSW_Enumerate : DSW_Enumerate_t;
|
|
|
|
DSW_InitInputBuffer : DSW_InitInputBuffer_t;
|
|
DSW_InitInputDevice : DSW_InitInputDevice_t;
|
|
DSW_StartInput : DSW_StartInput_t;
|
|
DSW_StopInput : DSW_StopInput_t;
|
|
DSW_ReadBlock : DSW_ReadBlock_t;
|
|
DSW_QueryInputFilled : DSW_QueryInputFilled_t;
|
|
|
|
Libhandle : HMODULE;
|
|
|
|
|
|
procedure TDXAudioOut.Prepare;
|
|
var
|
|
Res : HResult;
|
|
Wnd : HWND;
|
|
Form : TForm;
|
|
begin
|
|
if (FDeviceNumber >= FDeviceCount) then raise EACSException.Create(Format(strChannelnotavailable,[FDeviceNumber]));
|
|
FInput.Init;
|
|
FBuffer := AllocMem(FBufferSize);
|
|
Chan := FInput.Channels;
|
|
SR := FInput.SampleRate;
|
|
BPS := FInput.BitsPerSample;
|
|
DSW_Init(@DSW);
|
|
Res := DSW_InitOutputDevice(@DSW, Devices.dinfo[FDeviceNumber].guid);
|
|
if Res <> 0 then raise EACSException.Create(strFailedtoCreateDSdev);
|
|
{ if Owner is TForm then
|
|
begin
|
|
Form := Owner as TForm;
|
|
Wnd := Form.Handle;
|
|
end else }
|
|
Wnd := 0;
|
|
Res := DSW_InitOutputBuffer(@DSW, Wnd, BPS, SR, Chan, FBufferSize);
|
|
if Res <> 0 then raise EACSException.Create(strFailedtoCreateDSbuf);
|
|
StartInput := True;
|
|
EndOfInput := False;
|
|
end;
|
|
|
|
procedure TDXAudioOut.Done;
|
|
begin
|
|
Finput.Flush;
|
|
DSW_Term(@DSW);
|
|
FreeMem(FBuffer);
|
|
end;
|
|
|
|
function TDXAudioOut.DoOutput(Abort : Boolean):Boolean;
|
|
var
|
|
Len, offs, lb : Integer;
|
|
Stat : LongWord;
|
|
Res : HRESULT;
|
|
PlayTime, CTime : LongWord;
|
|
begin
|
|
Result := True;
|
|
if not Busy then Exit;
|
|
if not CanOutput then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
if Abort then
|
|
begin
|
|
DSW_StopOutput(@DSW);
|
|
CanOutput := False;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
if StartInput then
|
|
begin
|
|
Len := 0;
|
|
while Len < FBufferSize do
|
|
begin
|
|
offs := FInput.GetData(@FBuffer^[Len], FBufferSize-Len);
|
|
if offs = 0 then
|
|
begin
|
|
EndOfInput := True;
|
|
Break;
|
|
end;
|
|
Inc(Len, offs);
|
|
end;
|
|
DSW_WriteBlock(@DSW, @FBuffer^, Len);
|
|
DSW_StartOutput(@DSW);
|
|
StartInput := False;
|
|
end;
|
|
if EndOfInput then
|
|
begin
|
|
CanOutput := False;
|
|
PlayTime := Round(FBufferSize/(Chan*(BPS div 8)*SR))*1000;
|
|
CTime := 0;
|
|
while CTime < PlayTime do
|
|
begin
|
|
Sleep(100);
|
|
DSW_ZeroEmptySpace(@DSW);
|
|
Inc(CTime, 100);
|
|
end;
|
|
DSW_StopOutput(@DSW);
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
Sleep(DS_POLLING_INTERVAL);
|
|
DSW_QueryOutputSpace(@DSW, lb);
|
|
lb := lb - (lb mod 1024);
|
|
Len := 0;
|
|
while Len < lb do
|
|
begin
|
|
if FInput.Busy then
|
|
begin
|
|
try
|
|
offs := Finput.GetData(@FBuffer^[Len], lb-Len);
|
|
except
|
|
DSW_StopOutput(@DSW);
|
|
CanOutput := False;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if offs = 0 then Break;
|
|
Inc(Len, offs);
|
|
end;
|
|
DSW_WriteBlock(@DSW, @Fbuffer^, Len);
|
|
if offs = 0 then
|
|
begin
|
|
DSW_ZeroEmptySpace(@DSW);
|
|
EndOfInput := True;
|
|
end;
|
|
end;
|
|
|
|
constructor TDXAudioOut.Create;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBufferSize := $40000;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
if not LibdswLoaded then
|
|
raise EACSException.Create(Format(strCoudntloadlib,['dswrapper.dll']));
|
|
end;
|
|
if LibdswLoaded then DSW_Enumerate(Devices);
|
|
FDeviceCount := Devices.devcount;
|
|
end;
|
|
|
|
destructor TDXAudioOut.Destroy;
|
|
begin
|
|
if LibdswLoaded then DSW_Term(@DSW);
|
|
end;
|
|
|
|
procedure TDXAudioOut.Pause;
|
|
begin
|
|
if EndOfInput then Exit;
|
|
DSW_StopOutput(@DSW);
|
|
end;
|
|
|
|
procedure TDXAudioOut.Resume;
|
|
begin
|
|
if EndOfInput then Exit;
|
|
DSW_RestartOutput(@DSW);
|
|
end;
|
|
|
|
procedure TDXAudioOut.SetDevice(Ch: Integer);
|
|
begin
|
|
FBaseChannel := Ch;
|
|
end;
|
|
|
|
function TDXAudioOut.GetDeviceInfo: TACSDeviceInfo;
|
|
begin
|
|
if (FBaseChannel >= FDeviceCount) then
|
|
exit;
|
|
Result.DeviceName := PChar(@(Devices.dinfo[FBaseChannel].Name[0]));
|
|
end;
|
|
|
|
function TDXAudioOut.GetDeviceCount: Integer;
|
|
begin
|
|
Result := FDeviceCount;
|
|
end;
|
|
|
|
constructor TDXAudioIn.Create;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBPS := 8;
|
|
FChan := 1;
|
|
FFreq := 8000;
|
|
FSize := -1;
|
|
BufferSize := $2000;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
if not LibdswLoaded then
|
|
raise EACSException.Create(Format(strCoudntloadlib,['dswrapper.dll']));
|
|
end;
|
|
if LibdswLoaded then DSW_Enumerate(Devices);
|
|
FDeviceCount := Devices.devcount;
|
|
end;
|
|
|
|
destructor TDXAudioIn.Destroy;
|
|
begin
|
|
if LibdswLoaded then DSW_Term(@DSW);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDXAudioIn.OpenAudio;
|
|
var
|
|
Res : HResult;
|
|
BufSize : Integer;
|
|
begin
|
|
BufSize := BufferSize;
|
|
if FOpened = 0 then
|
|
begin
|
|
DSW_Init(@DSW);
|
|
if not Assigned(DSW_InitInputDevice) then raise EACSException.Create(Format(strChannelNotAvailable,[FDeviceNumber]));
|
|
Res := DSW_InitInputDevice(@DSW, Devices.dinfo[FDeviceNumber].guid);
|
|
if Res <> 0 then raise EACSException.Create(strFailedtoCreateDSdev);
|
|
Res := DSW_InitInputBuffer(@DSW, FBPS, FFreq, FChan, BufSize);
|
|
if Res <> 0 then raise EACSException.Create(strFailedtoCreateDSbuf);
|
|
end;
|
|
Inc(FOpened);
|
|
end;
|
|
|
|
procedure TDXAudioIn.CloseAudio;
|
|
begin
|
|
if FOpened = 1 then DSW_Term(@DSW);
|
|
if FOpened > 0 then Dec(FOpened);
|
|
end;
|
|
|
|
function TDXAudioIn.GetBPS : Integer;
|
|
begin
|
|
Result := FBPS;
|
|
end;
|
|
|
|
function TDXAudioIn.GetCh : Integer;
|
|
begin
|
|
Result := FChan;
|
|
end;
|
|
|
|
function TDXAudioIn.GetSR : Integer;
|
|
begin
|
|
Result := FFreq;
|
|
end;
|
|
|
|
procedure TDXAudioIn.Init;
|
|
begin
|
|
if Busy then raise EACSException.Create(strBusy);
|
|
if (FDeviceNumber >= FDeviceCount) then raise EACSException.Create(Format(strChannelnotavailable,[FDeviceNumber]));
|
|
if FRecTime > 0 then FBytesToRead := FRecTime*FFreq*FChan*(FBPS div 8);
|
|
BufEnd := 0;
|
|
BufStart := 1;
|
|
FPosition := 0;
|
|
FBusy := True;
|
|
FSize := FBytesToRead;
|
|
OpenAudio;
|
|
DSW_StartInput(@DSW);
|
|
end;
|
|
|
|
procedure TDXAudioIn.Flush;
|
|
begin
|
|
DSW_StopInput(@DSW);
|
|
CloseAudio;
|
|
FBusy := False;
|
|
end;
|
|
|
|
function TDXAudioIn.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
|
|
var
|
|
l : Integer;
|
|
begin
|
|
if not Busy then raise EACSException.Create(strStreamnotopen);
|
|
if (FBytesToRead >=0) and (FPosition >= FBytesToRead) then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
if BufStart >= BufEnd then
|
|
begin
|
|
BufStart := 0;
|
|
Sleep(DS_POLLING_INTERVAL);
|
|
DSW_QueryInputFilled(@DSW, l);
|
|
if l > BufferSize then
|
|
l := BufferSize; (* We have lost some data.
|
|
Generally this shouldn't happen. *)
|
|
l := l - (l mod 1024);
|
|
DSW_ReadBlock(@DSW, @FBuffer, l);
|
|
BufEnd := l;
|
|
end;
|
|
if BufferSize < (BufEnd - BufStart)
|
|
then Result := BufferSize
|
|
else Result := BufEnd - BufStart;
|
|
Move(FBuffer[BufStart], Buffer^, Result);
|
|
Inc(BufStart, Result);
|
|
Inc(FPosition, Result);
|
|
end;
|
|
|
|
procedure TDXAudioIn.SetRecTime;
|
|
begin
|
|
FRecTime := aRecTime;
|
|
if FRecTime > 0 then
|
|
FBytesToRead := FRecTime*FFreq*FChan*(FBPS div 8)
|
|
else
|
|
FBytesToRead := -1;
|
|
end;
|
|
|
|
procedure TDXAudioIn.SetDevice(i : Integer);
|
|
begin
|
|
FDeviceNumber := i
|
|
end;
|
|
|
|
function TDXAudioIn.GetDeviceName(Number : Integer) : String;
|
|
begin
|
|
if (Number < FDeviceCount) then Result := PChar(@(Devices.dinfo[Number].Name[0]))
|
|
else Result := '';
|
|
end;
|
|
|
|
function TDXAudioIn.GetTotalTime : real;
|
|
var
|
|
BytesPerSec : Integer;
|
|
begin
|
|
BytesPerSec := FFreq*FChan*(FBPS div 8);
|
|
Result := FBytesToRead/BytesPerSec;
|
|
end;
|
|
|
|
initialization
|
|
|
|
Libhandle := LoadLibraryEx('dswrapper.dll', 0, 0);
|
|
|
|
if Libhandle <> 0 then
|
|
begin
|
|
LibdswLoaded := True;
|
|
|
|
DSW_Init := GetProcAddress(Libhandle, 'DSW_Init');
|
|
DSW_Term := GetProcAddress(Libhandle, 'DSW_Term');
|
|
DSW_InitOutputDevice := GetProcAddress(Libhandle, 'DSW_InitOutputDevice');
|
|
DSW_InitOutputBuffer := GetProcAddress(Libhandle, 'DSW_InitOutputBuffer');
|
|
DSW_StartOutput := GetProcAddress(Libhandle, 'DSW_StartOutput');
|
|
DSW_StopOutput := GetProcAddress(Libhandle, 'DSW_StopOutput');
|
|
DSW_RestartOutput := GetProcAddress(Libhandle, 'DSW_RestartOutput');
|
|
DSW_GetOutputStatus := GetProcAddress(Libhandle, 'DSW_GetOutputStatus');
|
|
DSW_WriteBlock := GetProcAddress(Libhandle, 'DSW_WriteBlock');
|
|
DSW_ZeroEmptySpace := GetProcAddress(Libhandle, 'DSW_ZeroEmptySpace');
|
|
DSW_QueryOutputSpace := GetProcAddress(Libhandle, 'DSW_QueryOutputSpace');
|
|
DSW_Enumerate := GetProcAddress(Libhandle, 'DSW_Enumerate');
|
|
DSW_InitInputDevice := GetProcAddress(Libhandle, 'DSW_InitInputDevice');
|
|
DSW_InitInputBuffer := GetProcAddress(Libhandle, 'DSW_InitInputBuffer');
|
|
DSW_StartInput := GetProcAddress(Libhandle, 'DSW_StartInput');
|
|
DSW_StopInput := GetProcAddress(Libhandle, 'DSW_StopInput');
|
|
DSW_ReadBlock := GetProcAddress(Libhandle, 'DSW_ReadBlock');
|
|
DSW_QueryInputFilled := GetProcAddress(Libhandle, 'DSW_QueryInputFilled');
|
|
|
|
end;
|
|
|
|
RegisterAudioOut('DirectSound',TDXAudioOut,LATENCY);
|
|
RegisterAudioIn('DirectSound',TDXAudioIn,LATENCY);
|
|
|
|
finalization
|
|
|
|
if Libhandle <> 0 then FreeLibrary(Libhandle);
|
|
|
|
end.
|