mmfir.pas

一套及时通讯的原码

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMFIRFilter --------------------------------------------------------------}
destructor TMMFIRFilter.Destroy;
begin
   Close;

   SetResponse(nil);
   SetSpectrum(nil);

   FFilters.Free;

   inherited
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.Notification(aComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(aComponent, Operation);

   if (Operation = opRemove) then
   begin
      if (aComponent = FResponse) then
          FResponse := nil;

      if (aComponent = FSpectrum) then
          FSpectrum := nil;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.PcmOverflow;
begin
   if assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetCoeffs(pCoeffs: PFloatArray; nCoeffs: integer);
begin
   if (pCoeffs <> nil) then
   begin
      if (nCoeffs > MAXTAPS) then
          raise EMMFIRError.Create('Only '+IntToStr(MAXTAPS)+' are allowed');

//      FFirFunc := ffUser;
      FnCoeffs := nCoeffs;

      GlobalMoveMem(pCoeffs^,FCoeffs,nCoeffs*sizeOf(Float));

      Change;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
function TMMFIRFilter.GetCoeffs: PFloatArray;
begin
   Result := @FCoeffs;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
function TMMFIRFilter.LoadCoeffs(FName: TFileName): Boolean;
var
   F: TextFile;
   S: string;
   nCoeffs,n: integer;
   Coeffs: array[0..MAXTAPS-1] of Float;

begin
   Result := False;
   if FileExists(FName) then
   try
   {$I-}
      AssignFile(F, FName);
      Reset(F);
      try
         { read the number of coeffs }
         ReadLn(F, S);
         nCoeffs := StrToInt(S);
         n := 0;
         while not EOF(F) do
         begin
            ReadLn(F,S);
            Coeffs[n] := StrToFloat(S);
            inc(n);
         end;

         if (n = nCoeffs) then
         begin
            SetCoeffs(@Coeffs,nCoeffs);
            Result := True;
         end;

      finally
         CloseFile(F);
      end;

   except
      ;
   end;
   {$I+}
end;

{-- TMMFIRFilter --------------------------------------------------------------}
function TMMFIRFilter.SaveCoeffs(FName: TFileName): Boolean;
var
   F: TextFile;
   n: integer;

begin
   Result := False;
   try
   {$I-}
      AssignFile(F, FName);
      Rewrite(F);
      try
         { write the number of coeffs }
         WriteLn(F, IntToStr(FnCoeffs));
         for n := 0 to FnCoeffs-1 do
         begin
            WriteLn(F,FloatToStr(FCoeffs[n]));
         end;

         Result := True;

      finally
         CloseFile(F);
      end;

   except
      ;
   end;
   {$I+}
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SaveToIniFile(IniFile: TFileName; Section: string);
var
   i: integer;
begin
   if (IniFile <> '') then
   begin
      with TIniFile.Create(IniFile) do
      try
         Section := 'FIR.'+Section;
         WriteInteger(Section, 'Order', Order);
         WriteInteger(Section, 'Window', Ord(Window));

         WriteInteger(Section, 'Filters', Filters.Count);
         for i := 0 to Filters.Count-1 do
         with Filters[i] do
         begin
            WriteString(Section, 'Filter'+IntToStr(i)+' f1', FloatToStr(f1));
            WriteString(Section, 'Filter'+IntToStr(i)+' Gain', FloatToStr(Gain));
         end;

      finally
         Free;
      end;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.ReadFromIniFile(IniFile: TFileName; Section: string);
var
   Cnt, i: integer;
   f1,Gain: Float;

begin
   if (IniFile <> '') then
   begin
      with TIniFile.Create(IniFile) do
      try
         Section := 'FIR.'+Section;
         i := ReadInteger(Section, 'Order', -1);
         if (i > 0) then
         begin
            Filters.BeginUpdate;
            try
               FUpdating := True;

               Filters.FreeAll;

               Order       := ReadInteger(Section, 'Order', defOrder);
               Window      := TMMFFTWindow(ReadInteger(Section, 'Window', Ord(defWindow)));
               Description := Section;

               Cnt := ReadInteger(Section, 'Filters', 0);

               for i := 0 to Cnt-1 do
               begin
                  f1   := StrToFloat(ReadString(Section, 'Filter'+IntToStr(i)+' f1', '0'));
                  Gain := StrToFloat(ReadString(Section, 'Filter'+IntToStr(i)+' Gain', '0'));

                  Filters.AddObject(TMMFIRFilterItem.CreateEx(f1,Gain));
               end;

            finally
               FUpdating := False;
               Filters.EndUpdate;
            end;
         end;

      finally
         Free;
      end;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetFilters(aValue: TMMFIRFilterList);
begin
   if (aValue <> FFilters) then FFilters.Assign(aValue);
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.FilterChanged(Sender: TObject);
begin
   if not FUpdating then
   begin
      CalcFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.FiltersChanged(Sender: TObject);
begin
   if not FUpdating then
   begin
      CalcFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetDescription(aValue: String);
begin
   if (aValue <> FDescription) then
   begin
      FDescription := aValue;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
Procedure TMMFIRFilter.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
      UpdateFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetSampleRate(aValue: Longint);
begin
   if (aValue <> Ffs) then
   begin
      Ffs := MinMax(aValue,4000,100000);
      UpdateTempFilter(True);
      CalcFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetWindow(aValue: TMMFFTWindow);
begin
   if (aValue <> FWindow) then
   begin
      FWindow := aValue;
      CalcFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetNCoeffs(aValue: integer);
begin
   if (aValue <> FnCoeffs) then
   begin
      if (aValue mod 2 = 0) then inc(aValue);
      FnCoeffs := MinMax(aValue,0,MAXTAPS-1);
      CalcFilter;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetResponse(aValue: TMMFIRResponse);
begin
   if Longint(Self) = Longint(aValue) then exit;

   if (aValue <> FResponse) then
   begin
      if (aValue = nil) then NotifyResponse(opRemove);

      FResponse := aValue;

      NotifyResponse(opInsert);
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.NotifyResponse(Operation: TOperation);
begin
   if (FResponse = nil) or
      (csLoading in ComponentState) or
      (csReading in ComponentState) then exit;

   if (Operation = opInsert) then
   begin
      FResponse.SetCoeffs(@FCoeffs,FnCoeffs);
      FResponse.SampleRate := Ffs;
   end
   else
   begin
      FResponse.SetCoeffs(nil,0);
      FResponse.SampleRate := 0;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.UpdateTempFilter(Init: Boolean);
var
   wfx: TWaveFormatEx;
begin
   DoneFIRFilter(FPTempFIR);
   if Init and (FSpectrum <> nil) then
   begin
      pcmBuildWaveHeader(@wfx, 16, 1, Ffs);
      FPTempFIR := InitFIRFilter(@wfx);
      FSpectrum.PCMWaveFormat := PPCMWaveFormat(@wfx)^;
      NotifySpectrum;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SetSpectrum(aValue: TMMSpectrum);
begin
   if Longint(Self) = Longint(aValue) then exit;

   if (aValue <> FSpectrum) then
   begin
      if (aValue = nil) then
      begin
         FSpectrum.OnNeedData := nil;
         NotifySpectrum;
         UpdateTempFilter(False);
      end;

      FSpectrum := aValue;

      if (FSpectrum <> nil) then
      begin
         UpdateTempFilter(True);
         FSpectrum.Window := fwRectangular;
         FSpectrum.OnNeedData := SpectrumNeedData;
         NotifySpectrum;
      end;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.NotifySpectrum;
begin
   if (FSpectrum = nil) or
      (csLoading in ComponentState) or
      (csReading in ComponentState) then exit;

   FSpectrum.ResetData;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.SpectrumNeedData(Sender: TObject);
var
   wfx: TWaveFormatEx;
   BufI,BufO: array[0..8192] of Smallint;
begin
   if (Sender <> nil) then
   with TMMSpectrum(Sender) do
   begin
      pcmBuildWaveHeader(@wfx, 16, 1, Ffs);
      PCMWaveFormat := PPCMWaveFormat(@wfx)^;

      ResetFIRFilter(FPTempFIR);
      SetFIRFilter(FPTempFir, @FCoeffs, FnCoeffs, 0);
      
      GlobalFillMem(BufI,sizeOf(BufI),0);
      BufI[0] := 21500;
     
      DoFIRFilterShort(FPTempFir, @BufI, @BufO, BytesPerSpectrum);
      RefreshPCMData(@BufO);
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.CalcFilter;
var
   i,Cnt: integer;
   Pts: array[0..MAXFREQS-1] of TMMFilterPoint;

begin
   if not (csLoading in ComponentState) and
      not (csReading in ComponentState) then
   begin
      Filters.Sort;
      
      Cnt := Filters.Count;
      for i := 0 to Cnt-1 do
      with Filters[i] do
      begin
         Pts[i].Freq := Ff1;
         Pts[i].Amp  := FGain;
      end;

      { make sure we have at least two valid points }
      if (Cnt = 0) then
      begin
         Pts[0].Freq := 0;
         Pts[0].Amp  := 0;
         inc(Cnt);
      end;

      if (Cnt = 1) then
      begin
         Pts[1].Freq := Ffs/2;
         Pts[1].Amp  := 0;
         inc(Cnt);
      end;

      FIR_CoeffsEx(@Pts, Cnt, Ffs, FnCoeffs, @FCoeffs);
      FIR_Window(FWindow, FnCoeffs, @FCoeffs);

      Change;
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.UpdateFilter;
begin
   if FOpen and (FPFIR <> nil) then
   begin
      FCleanup := wioSamplesToBytes(PWaveFormat,FnCoeffs);

      SetFIRFilter(FPFIR, @FCoeffs, FnCoeffs, ord(FChannel));
   end;
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.Change;
begin
   UpdateFilter;

   NotifyResponse(opInsert);
   NotifySpectrum;

   if assigned(FOnChange) then FOnChange(Self);
end;

{-- TMMFIRFilter --------------------------------------------------------------}
procedure TMMFIRFilter.Loaded;
begin
   inherited Loaded;