mmeq.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]              =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 09.09.98 - 12:05:18 $                                        =}
{========================================================================}
unit MMEQ;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Controls,
    Forms,
    MMSystem,
    MMRegs,
    MMUtils,
    MMPcmSup,
    MMObj,
    MMDSPObj,
    MMObjLst,
    MMFFT,
    MMFFTFlt,
    MMSpectr,
    IniFiles,
    Registry;

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM defEnabled} {$ENDIF}
    defEnabled = True;
    {$IFDEF CBUILDER3} {$EXTERNALSYM defChannel} {$ENDIF}
    defChannel = chBoth;
    {$IFDEF CBUILDER3} {$EXTERNALSYM defFFTLen} {$ENDIF}
    defFFTLen  = 256;
    {$IFDEF CBUILDER3} {$EXTERNALSYM defRate} {$ENDIF}
    defRate    = 4000;
    {$IFDEF CBUILDER3} {$EXTERNALSYM defWindow} {$ENDIF}
    defWindow  = fwHamming;

type
   EMMEqualizerError = class(Exception);

   TMMEqualizer = class;

   {-- TMMEQFilter ------------------------------------------------------------}
   TMMEQFilter = class(TObject)
   private
      Ff1      : Float;
      Ff2      : Float;
      FGain    : Float;
      FData    : Pointer;
      FEnabled : Boolean;
      FOnChange: TNotifyEvent;

      procedure SetValue(index: integer; aValue: Float);
      procedure SetEnabled(aValue: Boolean);

      procedure Store(S: TStream); virtual;
      procedure Load(S: TStream); virtual;

   protected
      procedure Changed; virtual;

   public
      constructor Create;
      constructor CreateEx(af1,af2,aGain: Float);
      constructor CreateObject(af1,af2,aGain: Float; Data: Pointer);

      procedure Assign(Source: TObject);

      procedure SetParams(af1, af2, aGain: Float);

      property OnChange: TNotifyEvent read FOnChange write FOnChange;

      property f1: Float index 0 read Ff1 write SetValue;
      property f2: Float index 1 read Ff2 write SetValue;
      property Gain: Float index 2 read FGain write SetValue;
      property Data: Pointer read FData write FData;
      property Enabled: Boolean read FEnabled write SetEnabled;
   end;

   {-- TMMEQFilterList --------------------------------------------------------}
   TMMEQFilterList = class(TObjectList)
   private
      FEqualizer: TMMEqualizer;

      procedure SetFilter(Index: integer; Filter: TMMEQFilter);
      function  GetFilter(Index: integer): TMMEQFilter;

   protected
      procedure DefineProperties(Filer: TFiler); override;
      procedure ReadData(S: TStream); override;
      procedure WriteData(S: TStream); override;

   public
      function  AddObject(Item: TObject): TOLSize; override;

      procedure Assign(Source: TPersistent); override;
      property Items[Index: integer]: TMMEQFilter read GetFilter write SetFilter; default;
   end;

   {-- TMMEqualizer -----------------------------------------------------------}
   TMMEqualizer = class(TMMDSPComponent)
   private
      FEnabled       : Boolean;
      FOpen          : Boolean;
      FPFilter       : PFFTFilter;
      FPTempFilter   : PFFTFilter;
      FDescription   : String;
      FFTLen         : integer;
      FFilters       : TMMEQFilterList;
      FWindow        : TMMFFTWindow;
      Ffs            : Longint;
      FChannel       : TMMChannel;
      FUpdating      : Boolean;
      FRealBufSize   : Longint;
      FSpectrum      : TMMSpectrum;

      FOnChange      : TNotifyEvent;
      FOnPcmOverflow : TNotifyEvent;

      procedure SetFFTLen(aValue: integer);
      procedure SetSampleRate(aValue: Longint);
      procedure SetWindow(aValue: TMMFFTWindow);
      procedure SetEnabled(aValue: Boolean);
      procedure SetDescription(aValue: String);
      procedure SetFilters(aValue: TMMEQFilterList);
      procedure SetChannel(aValue: TMMChannel);
      procedure SetSpectrum(aValue: TMMSpectrum);
      procedure NotifySpectrum;
      procedure SpectrumNeedData(Sender: TObject);
      procedure FiltersChanged(Sender: TObject);
      procedure FilterChanged(Sender: TObject);
      procedure UpdateTempFilter(Init: Boolean);

   protected
      procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
      procedure Assign(Source: TPersistent); override;
      procedure Notification(AComponent: TComponent; Operation: TOperation); override;

      procedure Loaded; override;
      procedure Update; virtual;
      procedure ResetEQ; virtual;
      procedure Change; virtual;

      procedure Opened; override;
      procedure Closed; override;
      procedure Started; override;
      procedure Reseting; override;

      procedure PcmOverflow; dynamic;
      procedure BufferReady(lpwh: PWaveHdr); override;
      procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
   public
      constructor Create(aOwner: TComponent); override;
      destructor  Destroy; override;

      property IsOpen: Boolean read FOpen;

      procedure Open;
      procedure Reset;
      procedure Close;
      procedure Process(Buffer: PChar; Length: integer);

      procedure SaveToRegIniFile(Ini: TRegIniFile; Section: string);
      procedure ReadFromRegIniFile(Ini: TRegIniFile; Section: string);

      procedure SaveToIniFileEx(Ini: TIniFile; Section: string);
      procedure ReadFromIniFileEx(Ini: TIniFile; Section: string);

      procedure SaveToIniFile(IniFile: TFileName; Section: string);
      procedure ReadFromIniFile(IniFile: TFileName; Section: string);

   published
      property OnChange: TNotifyEvent read FOnChange write FOnChange;
      property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;

      property Input;
      property Output;
      property Enabled: Boolean read FEnabled write SetEnabled default defEnabled;
      property SampleRate: Longint read Ffs write SetSampleRate default defRate;
      property FFTLength: integer read FFTLen write SetFFTLen default defFFTLen;
      property Description: String read FDescription write SetDescription stored False;
      property Filters: TMMEQFilterList read FFilters write SetFilters;
      property Spectrum: TMMSpectrum read FSpectrum write SetSpectrum;
      property Channel: TMMChannel read FChannel write SetChannel default defChannel;
      property Window: TMMFFTWindow read FWindow write SetWindow default defWindow;
   end;


implementation

const
   STREAMKENNUNG : Longint = $00555145; { 'EQU ' }

{== TMMEQFilter ===============================================================}
constructor TMMEQFilter.Create;
begin
   inherited Create;

   Ff1      := 0;
   Ff2      := 0;
   FGain    := 0;
   FData    := nil;
   FEnabled := True;
   FOnChange:= nil;
end;

{-- TMMEQFilter ---------------------------------------------------------------}
constructor TMMEQFilter.CreateEx(af1,af2,aGain: Float);
begin
   inherited Create;

   Ff1      := af1;
   Ff2      := af2;
   FGain    := aGain;
   FEnabled := True;
   FOnChange:= nil;
end;

{-- TMMEQFilter ---------------------------------------------------------------}
constructor TMMEQFilter.CreateObject(af1,af2,aGain: Float; Data: Pointer);
begin
   CreateEx(af1,af2,aGain);
   FData := Data;
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.Changed;
begin
   if assigned(FOnChange) then FOnChange(Self);
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.SetParams(af1, af2, aGain: Float);
begin
   if (af1 <> Ff1) or (af2 <> Ff2) or (aGain <> FGain) then
   begin
      Ff1 := af1;
      Ff2 := af2;
      FGain := aGain;
      Changed;
   end;
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      Changed;
   end;
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.SetValue(index: integer; aValue: Float);
var
   af1,af2,aGain: Float;

begin
   af1 := Ff1;
   af2 := Ff2;
   aGain := FGain;
   case index of
       0: af1 := aValue;
       1: af2 := aValue;
       2: aGain := aValue;
   end;
   SetParams(af1, af2, aGain);
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.Store(S: TStream);
begin
   S.WriteBuffer(FEnabled,SizeOf(FEnabled));
   S.WriteBuffer(Ff1,SizeOf(Ff1));
   S.WriteBuffer(Ff2,SizeOf(Ff2));
   S.WriteBuffer(FGain,SizeOf(FGain));
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.Load(S: TStream);
var
   af1,af2,aGain: Float;

begin
   S.ReadBuffer(FEnabled,SizeOf(FEnabled));
   S.ReadBuffer(af1,SizeOf(af1));
   S.ReadBuffer(af2,SizeOf(af2));
   S.ReadBuffer(aGain,SizeOf(aGain));
   SetParams(af1,af2,aGain);
end;

{-- TMMEQFilter ---------------------------------------------------------------}
procedure TMMEQFilter.Assign(Source: TObject);
begin
   if Source is TMMEQFilter then
   begin
      SetParams(TMMEQFilter(Source).f1,
                TMMEQFilter(Source).f2,
                TMMEQFilter(Source).Gain);
      Data := TMMEQFilter(Source).Data;
      Enabled := TMMEQFilter(Source).Enabled;
   end;
end;

{== TMMEQFilterList ===========================================================}
procedure TMMEQFilterList.SetFilter(Index: integer; Filter: TMMEQFilter);
begin
   Put(Index, Filter);
end;

{-- TMMEQFilterList -----------------------------------------------------------}
function TMMEQFilterList.GetFilter(Index: integer): TMMEQFilter;
begin
   Result := TMMEQFilter(Get(Index));
end;

{-- TMMEQFilterList -----------------------------------------------------------}
function TMMEQFilterList.AddObject(Item: TObject): TOLSize;
begin
   Result := inherited AddObject(Item);
   (Item as TMMEQFilter).OnChange := FEqualizer.FilterChanged;
end;

{-- TMMEQFilterList -----------------------------------------------------------}
procedure TMMEQFilterList.Assign(Source: TPersistent);
var
   i: integer;
   Filter: TMMEQFilter;

begin
   if (Source is TMMEQFilterList) or (Source = nil) then
   begin
      BeginUpdate;
      try
         if (FEqualizer <> nil) then
             FEqualizer.FUpdating := True;

         FreeAll;
         if (Source <> nil) then