frmfft.pas

Delphi FFT Spectrum Analyzer

{ Params   : -                                                                 }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Stop recording.                                                   }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.StopRecording;
var
  Loop: integer;
begin
  WaveInReset(WaveInHandle);
  for Loop := 1 to num_buf do
    if pbuf[Loop]<>nil then
    begin
      FreeMem(pbuf[Loop]);
      pbuf[Loop] := nil;
    end;
  if OutRealFFT<>nil then FreeMem(OutRealFFT);
  OutRealFFT := nil;
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Form create.                                                      }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FreqMult   := 0;                                                             { Reset them so we could check on these }
  MaxIndex   := 0;
  SampleRate := 0;
  FFTSize    := 0;
  CreateColorPalette;
  CBoxWind.ItemIndex := 1;

  CBoxSamplerate.ItemIndex := 3;
  CBoxFFTSize.ItemIndex := 8;
  CBoxSamplerateChange(Sender);                                                { Auto start }
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Form destroy.                                                     }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  StopRecording;
  if OutRealFFT<>nil then FreeMem(OutRealFFT);
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Alpha input changed.                                              }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.AlphaEditChange(Sender: TObject);
var
  Result: single;
  Code  : integer;
begin
  val(AlphaEdit.Text, Result, Code);
  if Code = 0 then
  begin
    case WindowFunction of
      idBlackman : BlackmanAlpha := Result;
      idGaussian : GaussianAlpha := Result;
      idHamming  : HammingAlpha  := Result;
      idKaiser   : KaiserAlpha   := Result;
    end;
    CalcWindowFunctions(FFTSize);
    GainLabel.Caption := format('Correction gain: %1.2f',[CoherentGain[WindowFunction]]);
  end;
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Beta input changed.                                               }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.BetaEditChange(Sender: TObject);
var
  Result: single;
  Code  : integer;
begin
  val(BetaEdit.Text, Result, Code);
  if Code = 0 then
  begin
    case WindowFunction of
      idBlackman : BlackmanBeta := Result;
    end;
    CalcWindowFunctions(FFTSize);
    GainLabel.Caption := format('Correction gain: %1.2f',[CoherentGain[WindowFunction]]);
  end;
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Gamma input changed.                                              }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.GammaEditChange(Sender: TObject);
var
  Result: single;
  Code  : integer;
begin
  val(GammaEdit.Text, Result, Code);
  if Code = 0 then
  begin
    case WindowFunction of
      idBlackman : BlackmanGamma := Result;
    end;
    CalcWindowFunctions(FFTSize);
    GainLabel.Caption := format('Correction gain: %1.2f',[CoherentGain[WindowFunction]]);
  end;
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Paint frequency bar.                                              }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.FreqBarPaintBoxPaint(Sender: TObject);
var
  Loop : integer;
  Step : integer;
  OText: string;
begin
  if FreqMult=0 then Exit;
  FreqBarPaintBox.Canvas.Pen.Color := clYellow;
  FreqBarPaintBox.Width := MaxIndex + LogBarPaintBox.Width;
  FreqBarPaintBox.Canvas.FillRect(FreqBarPaintBox.ClientRect);
  FreqBarPaintBox.Canvas.MoveTo(0, 0);
  FreqBarPaintBox.Canvas.LineTo(MaxIndex, 0);
  Loop := 0;
  Step := (Samplerate div 2) div 10;                                           { 10 chuncks }
  Step := (Step div 500) * 500;                                                { 500 Hz parts }
  if Step= 0 then Step := 500;
  while Loop <= trunc(MaxIndex*FreqMult) do
    begin
      OText := format('%d',[Loop]);
      FreqBarPaintBox.Canvas.MoveTo(trunc(Loop/FreqMult),0);
      FreqBarPaintBox.Canvas.LineTo(trunc(Loop/FreqMult),10);
      if Loop<>0 then
        FreqBarPaintBox.Canvas.TextOut(trunc(Loop/FreqMult)-(FreqBarPaintBox.Canvas.TextWidth(OText) div 2),10,
                                       OText);
      inc(Loop, (Step div 2));
      if Loop <= trunc(MaxIndex*FreqMult) then
      begin
        FreqBarPaintBox.Canvas.MoveTo(trunc(Loop/FreqMult),0);
        FreqBarPaintBox.Canvas.LineTo(trunc(Loop/FreqMult),5);
        inc(Loop, (Step div 2));
      end;  
    end;
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Make vertical dB scale.                                           }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.LogBarPaintBoxPaint(Sender: TObject);
var
  Loop     : integer;
  Index    : integer;
  Step     : integer;
  OText    : string;
  ScaleY   : single;
  Temp     : single;
  PrevColor: integer;
begin
  if SampleRate = 0 then Exit;
  ScaleY := LogBarPaintBox.Height / MaxDb;
  LogBarPaintBox.Canvas.Pen.Color := clYellow;
  LogBarPaintBox.Left := FFTPaintBox.Left+FFTPaintBox.Width;
  DbLogLabel.Left     := LogBarPaintBox.Left + 5{(LogBarPaintBox.Width div 2)};
  FreqLabel.Left      := LogBarPaintBox.Left + (LogBarPaintBox.Width div 2);
  LogBarPaintBox.Canvas.FillRect(LogBarPaintBox.ClientRect);
  LogBarPaintBox.Canvas.MoveTo(0, 0);
  LogBarPaintBox.Canvas.LineTo(0, LogBarPaintBox.Height);
  Loop  := 0;
  Index := 0;
  Step  := 10;
  while Loop <= trunc(MaxdB) do
    begin
      LogBarPaintBox.Canvas.MoveTo(0,  trunc(Step * Index * ScaleY));
      LogBarPaintBox.Canvas.LineTo(10, trunc(Step * Index * ScaleY));
      if (Loop<>0) and (Loop<>MaxDb) then
      begin
        if SpectrogramBox.Checked
          then OText := format('%1.1f', [((SampleRate/2) - (((SampleRate/2)/(MaxDb/Step)) * (Loop/10)))/1000])
          else OText := format('%d',[Step * Index]);
        LogBarPaintBox.Canvas.TextOut(10, trunc(Step * Index * ScaleY) - (LogBarPaintBox.Canvas.TextHeight(OText) div 2), OText);
      end;
      inc(Loop, Step);
      inc(Index);
    end;
  FilterPanel.Left := LogBarPaintBox.Left + LogBarPaintBox.Width + 5;
  frmMain.Width := FilterPanel.Left + FilterPanel.Width + 20;
  if SpectrogramBox.Checked then
  begin
    ScaleY := LogBarPaintBox.Height / MaxColor;
    PrevColor := 0;
    for Loop := 0 to MaxColor do
    begin
      Temp := Loop * ScaleY;
      for Step := PrevColor to trunc(Temp) do
        for Index := 40 to 50 do
          LogBarPaintBox.Canvas.Pixels[Index, Step]:= ColorArray[Loop];
      PrevColor := trunc(Temp);
    end;
  end;  
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Change of frequency scrollbar.                                    }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.FreqScrollBarChange(Sender: TObject);
begin
  FilterFreq :=FreqScrollBar.Max-FreqScrollBar.Position;
  FreqFilterLabel.Caption := format('%d Hz',[FilterFreq]);
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Spectogram/Frequency display selection.                           }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.SpectrogramBoxClick(Sender: TObject);
begin
  SpectrogramIndex := 0;
  if SpectrogramBox.Checked then
  begin
    FFTPaintBox.Canvas.FillRect(frmMain.FFTPaintBox.ClientRect);
    SpectrogramHLabel.Visible := true;
    SpectrogramVLabel.Visible := true;
    FreqBarPaintBox.Visible   := false;
    FreqLabel.Visible         := false;
    dbLogLabel.Caption        := 'kHz';
  end
  else
  begin
    SpectrogramHLabel.Visible := false;
    SpectrogramVLabel.Visible := false;
    FreqBarPaintBox.Visible   := true;
    FreqLabel.Visible         := true;
    dbLogLabel.Caption        := 'dB';
  end;
  LogBarPaintBox.Repaint;                                  { Make sure other paintboxes adjusted }
end;


{ **************************************************************************** }
{ Params   : <Sender>  Sender object                                           }
{ Return   : -                                                                 }
{                                                                              }
{ Descript : Change of samplerate.                                             }
{ Notes    :                                                                   }
{ **************************************************************************** }
procedure TfrmMain.CBoxSamplerateChange(Sender: TObject);
begin
  StopRecording;
  StartRecording;
end;


initialization

finalization

end.