main.pas

VCL component dsplab , STFT and SPECTRUM viewer, real time

end;


procedure TMainForm.StopButtonClick(Sender: TObject);
begin
  if Audio <> nil then
  begin
    Audio.Stop;
    Audio.Position := 0;
  end;

  PlayButton.Enabled  := True;
  PauseButton.Enabled := False;
  StopButton.Enabled  := False;
  Timer.Enabled       := False;
  UpdateInfo;

  SpectrumValues.Clear;
end;


procedure TMainForm.TimerTimer(Sender: TObject);
begin
  if Audio.Playing then UpdateInfo else
    if Audio.Position >= Audio.Size then StopButtonClick(Self);

end;


procedure TMainForm.DisplayPanelResize(Sender: TObject);
begin
  PLeftDisp.Width:= DisplayPanel.Width div 2;
end;


procedure TMainForm.UpdateInfo;
var P: Integer;
begin
  if (Audio <> nil) and (Audio.Format <> nil) then
  begin
    P:= (Audio.Position div Audio.Format.nBlockAlign) div SamplesPerSec;

    PanLabel.Caption      := Format('Pan: %ddB', [Audio.Pan div 100]);
    VolumeLabel.Caption   := Format('Volume: %ddB', [Audio.Volume div 100]);
    ProgressLabel.Caption := Format('Time: %.2d:%.2d:%.2d', [(P div 60) div 60, (P div 60) mod 60, P mod 60]);
    BytesLabel.Caption    := Format('%d Bytes', [Audio.Position]);

    FUpdating:= true;
    try
      ProgressTrackBar.Position := Audio.Position;
    finally
      FUpdating:= false;
    end;
  end else
  begin
    PanLabel.Caption      := 'Pan';
    VolumeLabel.Caption   := 'Volume';
    ProgressLabel.Caption := 'Time';
    BytesLabel.Caption    := 'Bytes';
  end;
end;


procedure TMainForm.UpdateFileInfo;
var FileInfo: String;
begin
  if Audio <> nil then
  begin
    FileInfo:= Format('%d kHz, %d bit, ', [SamplesPerSec,  BitsPerSample]);
    if NumOfChannels = 1 then FileInfo:= FileInfo + 'Mono'
    else FileInfo:= FileInfo + 'Stereo';

    StatusBar1.Panels[0].Width:= StatusBar1.Canvas.TextWidth(FileInfo) + 10;
    StatusBar1.Panels[0].Text:= FileInfo;
  end else StatusBar1.Panels[0].Width:= 0;
end;

{==============================================================================}
{ Sound Processing                                                             }
{==============================================================================}

procedure TMainForm.OnDataRead(var Buffer; Count: Longint);

  procedure CalculateSpectrum(FFT: TdspFFT);
  var
    S: Single;
    I, N1, N2: Integer;
    SpectrumItem: PSpectrumItem;
    SpectrumData: PdspSingle;
  begin
    FFT.FFT;
    FFT.CalculateMagnitudes;

    CS.Acquire;
    try
      SpectrumItem:= SpectrumValues.Add;
      SpectrumItem.Channel:= FFT.Tag;
      SpectrumItem.Position:= Audio.WaveStream.Position;
      SpectrumData:= PdspSingle(@SpectrumItem.Values[0]);
      N1:= 0; N2:= 1;
      while N1 < FFT.BufferSize2 do
      begin
        S:= 0;
        for I:= N1 to N2 - 1 do S:= S + FFT.RealOut[I];

        SpectrumData^:= S;
        Inc(SpectrumData);
        N1:= N2;
        N2:= N2 * 2;
      end;
    finally
      CS.Release;
    end;
  end;

  procedure FFTFilter(FFT: TdspFFT; OLAP: PdspSingleArray);
  var
    S: Single;
    I: Integer;
  begin
    FFT.FFT;

    Move(PdspSingle(FFT.RealOut)^, PdspSingle(FFT.RealIn)^, FFT.BufferSize2*Sizeof(Single));
    Move(PdspSingle(FFT.ImagOut)^, PdspSingle(FFT.ImagIn)^, FFT.BufferSize2*Sizeof(Single));

    for I:= 0 to FFT.BufferSize2 do
    begin
      S:=             FFT.RealIn[I] * FFTEq.RealOut[I] - FFT.ImagIn[I] * FFTEq.ImagOut[I];
      FFT.ImagIn[I]:= FFT.RealIn[I] * FFTEq.ImagOut[I] + FFT.ImagIn[I] * FFTEq.RealOut[I];
      FFT.RealIn[I]:= S;
    end;

    for I:= 1 to FFT.BufferSize2 do
    begin
      FFT.RealIn[FFT.BufferSize - I]:=  FFT.RealIn[I];
      FFT.ImagIn[FFT.BufferSize - I]:= -FFT.ImagIn[I];
    end;

    FFT.IFFT;

    for I:= 0 to FilterLen - 2 do FFT.RealOut[I]:= FFT.RealOut[I] + OLAP[I];
    for I:= 0 to FilterLen - 2 do OLAP[I]:= FFT.RealOut[FilterDataSize + I];
  end;


  { Process Mono }
  procedure ProcessMono;
  var
    I: Integer;
    VL, VGL: Single;
    PV: PSmallInt;
  begin
    PV:= PSmallInt(@Buffer);
    for I:= 0 to FilterDataSize - 1 do
    begin
      FFTLeft.RealIn[I]:= PV^; Inc(PV);
    end;

    FFTFilter(FFTLeft, OverlapL);

    PV:= PSmallInt(@Buffer);
    for I:= 0 to FilterDataSize - 1 do
    begin
      PeakGainLeft:= Min(1, PeakGainLeft + 0.000005);
      PeakGainRight:= Min(1, PeakGainRight + 0.000005);
      VL:= FFTLeft.RealOut[I];
      VL:= VL + LPLeft.Filter(VL) * BassGain + HPLeft.Filter(VL) * TrebleGain;
      VL:= VL * Preamp;

      if Clipped then
      begin
        if Abs(VL) > High(SmallInt) then
        begin
          VGL:= High(SmallInt) / Abs(VL);
          PeakGainLeft:= Min(PeakGainLeft, VGL);
        end;
        VL:= VL * PeakGainLeft;
      end else
      begin
        VL:=  Min(High(SmallInt), Max(VL, Low(SmallInt)));
      end;

      PV^:= Round(VL); Inc(PV);
    end;

    PV:= PSmallInt(@Buffer);
    for I:= 0 to Min(FilterDataSize, FFTSpectrum1.BufferSize) - 1 do
    begin
      FFTSpectrum1.RealIn[I]:= PV^; Inc(PV);
    end;

    CalculateSpectrum(FFTSpectrum1);
  end;

  { Process Stereo }
  procedure ProcessStereo;
  var
    I: Integer;
    VL, VR, VGL, VGR: Single;
    PV: PSmallInt;
  begin
    PV:= PSmallInt(@Buffer);
    for I:= 0 to FilterDataSize - 1 do
    begin
      FFTLeft.RealIn[I]:= PV^; Inc(PV);
      FFTRight.RealIn[I]:= PV^; Inc(PV);
    end;

    FFTFilter(FFTLeft, OverlapL);
    FFTFilter(FFTRight, OverlapR);

    PV:= PSmallInt(@Buffer);
    for I:= 0 to FilterDataSize - 1 do
    begin
      PeakGainLeft:= Min(1, PeakGainLeft + 0.000005);
      PeakGainRight:= Min(1, PeakGainRight + 0.000005);
      VL:= FFTLeft.RealOut[I];
      VL:= VL + lPLeft.Filter(VL) * BassGain + HPLeft.Filter(VL) * TrebleGain;
      VL:= VL * Preamp;

      if Clipped then
      begin
        if Abs(VL) > High(SmallInt) then
        begin
          VGL:= High(SmallInt) / Abs(VL);
          PeakGainLeft:= Min(PeakGainLeft, VGL);
        end;
        VL:= VL * PeakGainLeft;
      end else
      begin
        VL:=  Min(High(SmallInt), Max(VL, Low(SmallInt)));
      end;

      PV^:= Round(VL); Inc(PV);

      VR:= FFTRight.RealOut[I];
      VR:= VR + LPRight.Filter(VR) * BassGain + HPRight.Filter(VR) * TrebleGain;
      VR:= VR * Preamp;
      if Clipped then
      begin
        if Abs(VR) > High(SmallInt) then
        begin
          VGR:= High(SmallInt) / Abs(VR);
          PeakGainRight:= Min(PeakGainRight, VGR);
        end;
        VR:= VR * PeakGainRight;
      end else
      begin
        VR:= Min(High(SmallInt), Max(VR, Low(SmallInt)));
      end;

      PV^:= Round(VR); Inc(PV);
    end;

    PV:= PSmallInt(@Buffer);
    for I:= 0 to Min(FilterDataSize, FFTSpectrum1.BufferSize) - 1 do
    begin
      FFTSpectrum1.RealIn[I]:= PV^; Inc(PV);
      FFTSpectrum2.RealIn[I]:= PV^; Inc(PV);
    end;

    CalculateSpectrum(FFTSpectrum2);
    CalculateSpectrum(FFTSpectrum1);
  end;

begin
  //Exit;
  try
    FFTLeft.Clear; FFTRight.Clear;
    FFTSpectrum1.Clear; FFTSpectrum2.Clear;
    if NumOfChannels = 1 then ProcessMono else ProcessStereo;
  except
    StopButtonClick(nil);
    raise;
  end;
end;


procedure TMainForm.SetupProcessingParameters;
var P: Integer;
begin
  if SamplesPerSec > 0 then
  begin
    LPLeft.SampleRate:= SamplesPerSec;
    LPRight.SampleRate:= SamplesPerSec;
    HPLeft.SampleRate:= SamplesPerSec;
    HPRight.SampleRate:= SamplesPerSec;

    case SamplesPerSec of
      11025: P:= 8;
      22050: P:= 9;
      44100: P:= 10;
    else P:= 10;
    end;

    FFTSpectrum1.Power:= P - 1;
    FFTSpectrum2.Power:= FFTSpectrum1.Power;

    FFTEq.Power:= P;
    FFTLeft.Power:= P;
    FFTRight.Power:= P;
    FilterLen:= Round(Power(2, P - 2));
    GetMem(OverlapL, FilterLen * Sizeof(Single));
    GetMem(OverlapR, FilterLen * Sizeof(Single));
    FilterDataSize:= FFTLeft.BufferSize - FilterLen + 1;

    Audio.dspBufferSize:= FilterDataSize * 2 * NumOfChannels;

    for P:= 0 to FilterLen - 1 do
    begin
      OverlapL[P]:= 0;
      OverlapR[P]:= 0;
    end;

    TrackBar1Change(TB1);
  end;
end;


procedure TMainForm.Timer1Timer(Sender: TObject);
var
  I, Position: Integer;
  K: Single;
  IsFound: Boolean;
  SpectrumItem: PSpectrumItem;
  DispValues: PSpectrumArray;
begin
  IsFound:= false;
  CS.Acquire;
  try
    if SpectrumValues.Count > 0 then
    begin
      Position:= Audio.Position;
      while SpectrumValues.Count > 0 do
      begin
        SpectrumItem:= SpectrumValues[0];
        if SpectrumItem.Position <= Position then
        begin
          if SpectrumItem.Channel = 0 then DispValues:= @LeftDisp.Values
          else DispValues:= @RightDisp.Values;

          for I:= 0 to FFTSpectrum1.Power - 1 do
          begin
            if DispValues[I] < SpectrumItem.Values[I] then K:= 0.5 else K:= 0.1;
            DispValues[I]:= DispValues[I] + (SpectrumItem.Values[I] - DispValues[I])* K;
          end;

          SpectrumValues.Delete(0);
          IsFound:= true;
        end else
        begin
          Break;
        end;
      end;
    end else
    if (Audio = nil) or (Audio.Playing = false) then
    begin
      // HideValues
      for I:= 0 to FFTSpectrum1.Power - 1 do
      begin
        LeftDisp.Values[I]:= LeftDisp.Values[I] * 0.9;
        RightDisp.Values[I]:= RightDisp.Values[I] * 0.9;
        IsFound:= IsFound or
          (LeftDisp.Values[I] > 0.0001) or (RightDisp.Values[I] > 0.0001);
      end;
    end;
  finally
    CS.Release;
  end;

  if IsFound then
  begin
    LeftDisp.Paint;
    RightDisp.Paint;
  end;
end;


procedure TMainForm.TrackBar1Change(Sender: TObject);
var
  TB: TTrackBar;
  V: Single;

  procedure BuildFFTFilter;
  var I, Index, M, N, N1, N2: Integer;
  begin
    FFTEq.Clear;

    N:= 0; N1:= 1; N2:= 2;
    FFTEq.RealIn[N]:= 1;
    while N1 < FFTEq.BufferSize2 do
    begin
      for I:= N1 to N2 do FFTEq.RealIn[I]:= AmpCoeffs[N];

      Inc(N);
      N1:= N2;
      N2:= N2 * 2;
    end;

    for I:= 1 to FFTEq.BufferSize2 do
    begin
      FFTEq.RealIn[FFTEq.BufferSize - I]:=  FFTEq.RealIn[I];
      FFTEq.ImagIn[FFTEq.BufferSize - I]:= -FFTEq.ImagIn[I];
    end;

    FFTEq.IFFT;

    M:= FilterLen;
    for I:= 0 TO FFTEq.BufferSize - 1  do
    begin
     INDEX:= I + (M div 2);
     IF INDEX >= FFTEq.BufferSize THEN INDEX:= INDEX - FFTEq.BufferSize;
     FFTEq.ImagOut[INDEX]:= FFTEq.RealOut[I];
    end;

   FOR I:= 0 TO FFTEq.BufferSize - 1 do
   begin
     IF I <= M THEN FFTEq.RealIn[I]:= FFTEq.ImagOut[I]
     else FFTEq.RealIn[I]:= 0;
     FFTEq.ImagIn[I]:= 0;
   end;

   dspApplyWindow(fwHamming, PdspSingle(FFTEq.RealIn), M + 1);

   FFTEq.FFT;
 end;

begin
  TB:= TTrackBar(Sender);
  V:= Power(10, -TB.Position / 20);
  AmpCoeffs[TB.Tag]:= V;

  BuildFFTFIlter;

  TB.Hint:= Format('%d db', [-TB.Position]);
  {$IFNDEF VER120}
  Application.ActivateHint(Mouse.CursorPos);
  {$ENDIF}
end;


procedure TMainForm.TimbreChange(Sender: TObject);
begin
  BassGain:= Power(10, TBBass.Position / 20) - 1;
  TrebleGain:= Power(10, TBTreble.Position / 20) - 1;
  Preamp:= Power(10, TBPreamp.Position / 20);

  TBBass.Hint:= IntToStr(TBBass.Position) + ' dB';
  TBTreble.Hint:= IntToStr(TBTreble.Position) + ' dB';
  TBPreamp.Hint:= IntToStr(TBPreamp.Position) + ' dB';

  {$IFNDEF VER120}
  Application.ActivateHint(Mouse.CursorPos);
  {$ENDIF}
end;

procedure TMainForm.cbClipClick(Sender: TObject);
begin
  Clipped:= cbClip.Checked;
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
  fmAbout.ShowModal;
end;

end.