548 lines
14 KiB
ObjectPascal
548 lines
14 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_misc.pas,v $
|
|
Revision 1.4 2006/08/31 20:10:54 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.3 2006/07/04 17:12:45 z0m3ie
|
|
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)
|
|
|
|
Revision 1.1 2005/12/19 18:34:35 z0m3ie
|
|
*** empty log message ***
|
|
|
|
Revision 1.4 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.3 2005/09/13 21:54:11 z0m3ie
|
|
acs is localizeable now (ACS_Strings)
|
|
|
|
Revision 1.2 2005/09/13 04:04:50 z0m3ie
|
|
First release without Components for Fileformats
|
|
only TFileIn and TFileOut are Visible
|
|
|
|
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.9 2005/09/07 20:53:22 z0m3ie
|
|
begon to add MPEG and WMA support using DirectX
|
|
|
|
Revision 1.8 2005/09/04 17:59:37 z0m3ie
|
|
moving CDIn support to AKRip mostly
|
|
begon to add mpegin support for Win with mpg123
|
|
|
|
Revision 1.7 2005/08/28 18:35:53 z0m3ie
|
|
created Delphi package for 2.4
|
|
more Mixer stuff
|
|
updated some things for Delphi
|
|
|
|
Revision 1.6 2005/08/22 20:17:01 z0m3ie
|
|
changed Headers to log
|
|
changed mail adress
|
|
|
|
}
|
|
|
|
unit acs_misc;
|
|
|
|
{$ifdef fpc}
|
|
{$mode delphi}
|
|
{$endif}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, ACS_Types, ACS_Classes, ACS_Strings
|
|
{$IFDEF LINUX}
|
|
,baseunix, LibAO
|
|
{$ENDIF};
|
|
|
|
const
|
|
BUF_SIZE = $4000;
|
|
|
|
type
|
|
TACSOnBufferDone = procedure(Sender : TComponent) of object;
|
|
|
|
TACSAudioProcessorInitEvent = procedure(Sender : TComponent; var TotalSize : Integer) of object;
|
|
TACSAudioProcessorFlushEvent = procedure(Sender : TComponent) of object;
|
|
|
|
TACSGetParameterEvent = procedure(Sender : TComponent; var Param : Integer) of object;
|
|
|
|
TACSGetRealParameterEvent = procedure(Sender : TComponent; var Param : real) of object;
|
|
|
|
TACSGetDataEvent = procedure(Sender : TComponent; Data : Pointer; var n : Integer) of object;
|
|
|
|
TACSMemoryIn = class(TACSCustomInput)
|
|
private
|
|
FBuffer : PACSBuffer8;
|
|
FDataSize : Integer;
|
|
FOnBufferDone : TACSOnBufferDone;
|
|
Busy : Boolean;
|
|
BufStart, BufEnd : Integer;
|
|
FBPS, FSR, FChan : Integer;
|
|
function GetBuffer : Pointer;
|
|
procedure SetBuffer(v : Pointer);
|
|
protected
|
|
function GetBPS : Integer; override;
|
|
function GetCh : Integer; override;
|
|
function GetSR : Integer; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetData(Buffer : Pointer; BufferSize : Integer): Integer; override;
|
|
procedure Init; override;
|
|
procedure Flush; override;
|
|
property DataBuffer : Pointer read GetBuffer write SetBuffer;
|
|
property DataSize : Integer read FDataSize write FDataSize;
|
|
published
|
|
property GlobalSize : Integer read FSize write FSize;
|
|
property InBitsPerSample : Integer read GetBPS write FBPS;
|
|
property InChannels : Integer read GetCh write FChan;
|
|
property InSampleRate : Integer read GetSR write FSR;
|
|
property OnBufferDone : TACSOnBufferDone read FOnBufferDone write FOnBufferDone;
|
|
end;
|
|
|
|
TACSAudioProcessor = class(TACSCustomConverter)
|
|
private
|
|
FOnInit : TACSAudioProcessorInitEvent;
|
|
FOnFlush : TACSAudioProcessorFlushEvent;
|
|
FOnGetData : TACSGetDataEvent;
|
|
FOnGetSampleRate : TACSGetParameterEvent;
|
|
FOnGetBitsPerSample : TACSGetParameterEvent;
|
|
FOnGetChannels : TACSGetParameterEvent;
|
|
FOnGetTotalTime : TACSGetRealParameterEvent;
|
|
FOnGetSize : TACSGetParameterEvent;
|
|
protected
|
|
function GetBPS : Integer; override;
|
|
function GetCh : Integer; override;
|
|
function GetSR : Integer; override;
|
|
function GetTotalTime : real; override;
|
|
public
|
|
function GetData(Buffer : Pointer; BufferSize : Integer): Integer; override;
|
|
procedure Init; override;
|
|
procedure Flush; override;
|
|
published
|
|
property OnFlush : TACSAudioProcessorFlushEvent read FOnFlush write FOnFlush;
|
|
property OnGetBitsPerSample : TACSGetParameterEvent read FOnGetBitsPerSample write FOnGetBitsPerSample;
|
|
property OnGetChannels : TACSGetParameterEvent read FOnGetChannels write FOnGetChannels;
|
|
property OnGetData : TACSGetDataEvent read FOnGetData write FOnGetData;
|
|
property OnGetSampleRate : TACSGetParameterEvent read FOnGetSampleRate write FOnGetSampleRate;
|
|
property OnGetSize : TACSGetParameterEvent read FOnGetSize write FOnGetSize;
|
|
property OnGetTotalTime : TACSGetrealParameterEvent read FOnGetTotalTime write FOnGetTotalTime;
|
|
property OnInit : TACSAudioProcessorInitEvent read FOnInit write FOnInit;
|
|
end;
|
|
|
|
TACSNULLOut = class(TACSCustomOutput)
|
|
private
|
|
Buf : array[0..BUF_SIZE-1] of Byte;
|
|
protected
|
|
procedure Done; override;
|
|
function DoOutput(Abort : Boolean):Boolean; override;
|
|
procedure Prepare; override;
|
|
end;
|
|
|
|
TACSInputItem = class(TCollectionItem)
|
|
protected
|
|
FInput : TACSCustomInput;
|
|
function GetOwner : TPersistent; override;
|
|
published
|
|
property Input : TACSCustomInput read FInput write FInput;
|
|
end;
|
|
|
|
TACSInputItems = class(TOwnedCollection)
|
|
end;
|
|
|
|
TACSInputChangedEvent = procedure(Sender : TComponent; var Index : Integer; var Continue : Boolean) of object;
|
|
|
|
TACSInputList = class(TACSCustomInput)
|
|
private
|
|
FCurrentInput : Integer;
|
|
FInputItems : TACSInputItems;
|
|
Lock : Boolean;
|
|
FOnInputChanged : TACSInputChangedEvent;
|
|
FIndicateProgress : Boolean;
|
|
procedure SetCurrentInput(aInput : Integer);
|
|
procedure SetInputItems(aItems : TACSInputItems);
|
|
protected
|
|
function GetBPS : Integer; override;
|
|
function GetCh : Integer; override;
|
|
function GetSR : Integer; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetData(Buffer : Pointer; BufferSize : Integer): Integer; override;
|
|
procedure Init; override;
|
|
procedure Flush; override;
|
|
property CurrentInput : Integer read FCurrentInput write SetCurrentInput;
|
|
published
|
|
property IndicateProgress : Boolean read FIndicateProgress write FIndicateProgress;
|
|
property InputItems : TACSInputItems read FInputItems write SetInputItems;
|
|
property OnInputChanged : TACSInputChangedEvent read FOnInputChanged write FOnInputChanged;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{$IFDEF LINUX}
|
|
|
|
var
|
|
AOInitialized : Integer = 0;
|
|
|
|
{$ENDIF}
|
|
|
|
constructor TACSMemoryIn.Create;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSize := -1;
|
|
end;
|
|
|
|
destructor TACSMemoryIn.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TACSMemoryIn.GetBPS : Integer;
|
|
begin
|
|
if (FBPS in [8, 16]) = False then FBPS := 16;
|
|
Result := FBPS;
|
|
end;
|
|
|
|
function TACSMemoryIn.GetCh : Integer;
|
|
begin
|
|
if (FChan in [1..2]) = False then FChan := 1;
|
|
Result := FChan;
|
|
end;
|
|
|
|
function TACSMemoryIn.GetSR : Integer;
|
|
begin
|
|
if (FSR < 4000) or (FSR > 48000) then FSR := 8000;
|
|
Result := FSR;
|
|
end;
|
|
|
|
procedure TACSMemoryIn.Init;
|
|
begin
|
|
FPosition := 0;
|
|
BufEnd := FDataSize;
|
|
BufStart := 1;
|
|
Busy := True;
|
|
end;
|
|
|
|
procedure TACSMemoryIn.Flush;
|
|
begin
|
|
Busy := False;
|
|
FDataSize := 0;
|
|
end;
|
|
|
|
function TACSMemoryIn.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
|
|
begin
|
|
if not Busy then raise EACSException.Create(strStreamnotopen);
|
|
if not Assigned(FBuffer) then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
if BufStart > BufEnd then
|
|
begin
|
|
BufStart := 1;
|
|
if FDataSize = 0 then
|
|
begin
|
|
if Assigned(FOnBufferDone) then FOnBufferDone(Self)
|
|
else
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
BufEnd := FDataSize;
|
|
if FDataSize = 0 then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if BufferSize < (BufEnd - BufStart + 1)
|
|
then Result := BufferSize
|
|
else Result := BufEnd - BufStart + 1;
|
|
Move(FBuffer[BufStart-1], Buffer^, Result);
|
|
Inc(BufStart, Result);
|
|
Inc(FPosition, Result);
|
|
Dec(FDataSize, Result);
|
|
end;
|
|
|
|
function TACSMemoryIn.GetBuffer : Pointer;
|
|
begin
|
|
Result := Pointer(FBuffer);
|
|
end;
|
|
|
|
procedure TACSMemoryIn.SetBuffer;
|
|
begin
|
|
FBuffer := PACSBuffer8(v);
|
|
end;
|
|
|
|
function TACSAudioProcessor.GetBPS : Integer;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnGetBitsPerSample) then FOnGetBitsPerSample(Self, Result) else
|
|
Result := FInput.BitsPerSample;
|
|
end;
|
|
|
|
function TACSAudioProcessor.GetSR : Integer;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnGetSampleRate) then FOnGetSampleRate(Self, Result) else
|
|
Result := FInput.SampleRate;
|
|
end;
|
|
|
|
function TACSAudioProcessor.GetCh : Integer;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnGetChannels) then FOnGetChannels(Self, Result) else
|
|
Result := FInput.Channels;
|
|
end;
|
|
|
|
function TACSAudioProcessor.GetTotalTime : real;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnGetTotalTime) then FOnGetTotalTime(Self, Result) else
|
|
Result := FInput.TotalTime;
|
|
end;
|
|
|
|
function TACSAudioProcessor.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
Result := BufferSize;
|
|
if Assigned(FOnGetData) then FOnGetData(Self, Buffer, Result)
|
|
else Result := FInput.GetData(Buffer, BufferSize);
|
|
Inc(FPosition, Result);
|
|
// if Result = 0 then
|
|
// Result := Result shl 1;
|
|
end;
|
|
|
|
procedure TACSAudioProcessor.Init;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnInit) then FOnInit(Self, FSize)
|
|
else
|
|
begin
|
|
FInput.Init;
|
|
if Assigned(FOnGetSize) then FOnGetSize(Self, FSize)
|
|
else FSize := Finput.Size;
|
|
end;
|
|
FBusy := True;
|
|
FPosition := 0;
|
|
end;
|
|
|
|
procedure TACSAudioProcessor.Flush;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
if Assigned(FOnFlush) then FOnFlush(Self)
|
|
else FInput.Flush;
|
|
FBusy := False;
|
|
end;
|
|
|
|
procedure TACSNULLOut.Prepare;
|
|
begin
|
|
if not Assigned(FInput) then
|
|
raise EACSException.Create(strInputnotAssigned);
|
|
FInput.Init;
|
|
end;
|
|
|
|
function TACSNULLOut.DoOutput(Abort : Boolean):Boolean;
|
|
begin
|
|
Result := True;
|
|
if not Busy then Exit;
|
|
if Abort or (not CanOutput) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
if Finput.GetData(@Buf[0], BUF_SIZE) > 0 then Result := True
|
|
else
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TACSNULLOut.Done;
|
|
begin
|
|
FInput.Flush;
|
|
end;
|
|
|
|
function TACSInputItem.GetOwner : TPersistent;
|
|
begin
|
|
Result := Collection;
|
|
end;
|
|
|
|
constructor TACSInputList.Create;
|
|
begin
|
|
inherited Create(AOwner);
|
|
FInputItems := TACSInputItems.Create(Self, TACSInputItem);
|
|
FPosition := 0;
|
|
FSize := -1;
|
|
FIndicateProgress := True;
|
|
end;
|
|
|
|
destructor TACSInputList.Destroy;
|
|
begin
|
|
FInputItems.Free;
|
|
Inherited Destroy;
|
|
end;
|
|
|
|
procedure TACSInputList.SetCurrentInput;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
if aInput <> 0 then
|
|
if (aInput < 0) or (aInput >= FInputItems.Count) then
|
|
raise EACSException.Create(Format(strListIndexOOB,[aInput]));
|
|
if Busy then
|
|
begin
|
|
while Lock do;
|
|
Lock := True;
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
I.Input.Flush;
|
|
I := TACSInputItem(InputItems.Items[aInput]);
|
|
I.Input.Init;
|
|
if FIndicateProgress then
|
|
FSize := I.Input.Size
|
|
else FSize := -1;
|
|
FPosition := 0;
|
|
Lock := False;
|
|
end;
|
|
FCurrentInput := aInput;
|
|
end;
|
|
|
|
function TACSInputList.GetBPS : Integer;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
if Busy then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
Result := I.Input.BitsPerSample;
|
|
end else
|
|
if InputItems.Count > 0 then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[0]);
|
|
Result := I.Input.BitsPerSample;
|
|
end;
|
|
end;
|
|
|
|
function TACSInputList.GetCh : Integer;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
if Busy then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
Result := I.Input.Channels;
|
|
end else
|
|
if InputItems.Count > 0 then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[0]);
|
|
Result := I.Input.Channels;
|
|
end;
|
|
end;
|
|
|
|
function TACSInputList.GetSR : Integer;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
if Busy then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
Result := I.Input.SampleRate;
|
|
end else
|
|
if InputItems.Count > 0 then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[0]);
|
|
Result := I.Input.SampleRate;
|
|
end;
|
|
end;
|
|
|
|
procedure TACSInputList.Init;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
if Busy then
|
|
raise EACSException.Create(strBusy);
|
|
if InputItems.Count = 0 then
|
|
raise EACSException.Create(strNoInputItems);
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
if not Assigned(I.Input) then
|
|
raise EACSException.Create(Format(strNoInputAssigned,[FCurrentInput]));
|
|
FBusy := True;
|
|
I.Input.Init;
|
|
if FIndicateProgress then
|
|
FSize := I.Input.Size
|
|
else FSize := -1;
|
|
FPosition := 0;
|
|
end;
|
|
|
|
procedure TACSInputList.Flush;
|
|
var
|
|
I : TACSInputItem;
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
I.Input.Flush;
|
|
FCurrentInput := 0;
|
|
Lock := False;
|
|
FBusy := False;
|
|
end;
|
|
|
|
function TACSInputList.GetData(Buffer : Pointer; BufferSize : Integer): Integer;
|
|
var
|
|
I : TACSInputItem;
|
|
Continue : Boolean;
|
|
begin
|
|
while Lock do;
|
|
Lock := True;
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
Result := I.Input.GetData(Buffer, BufferSize);
|
|
while Result = 0 do
|
|
begin
|
|
if FCurrentInput < InputItems.Count -1 then
|
|
begin
|
|
I.Input.Flush;
|
|
Inc(FCurrentInput);
|
|
Continue := True;
|
|
if Assigned(FonInputChanged) then
|
|
FonInputChanged(Self, FCurrentInput, Continue);
|
|
if Continue then
|
|
begin
|
|
I := TACSInputItem(InputItems.Items[FCurrentInput]);
|
|
if not Assigned(I.Input) then
|
|
raise EACSException.Create(Format(strNoInputAssigned,[FCurrentInput]));
|
|
I.Input.Init;
|
|
if FIndicateProgress then
|
|
FSize := I.Input.Size
|
|
else FSize := -1;
|
|
FPosition := 0;
|
|
Result := I.Input.GetData(Buffer, BufferSize);
|
|
end else Break;
|
|
end else Break;
|
|
end;
|
|
if FIndicateProgress then
|
|
FPosition := I.Input.Position;
|
|
Lock := False;
|
|
end;
|
|
|
|
procedure TACSInputList.SetInputItems;
|
|
begin
|
|
FInputItems.Assign(aItems);
|
|
end;
|
|
end.
|