main.pas

VCL component dsplab , STFT and SPECTRUM viewer, real time

{
  The simple demo of sound processing and visualization
  Author:  Eugen Tarasov

  This demo is based on the DelphiX sample and library.
  There is only 16 bit wave support

  Last modified - Jule, 2004

  Please send all suggestions to author

  e-mail: [e-mail]
  http://www.teworks.com
}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ComCtrls, DXSounds, MMSystem, Wave, AudioStream,
  Math, dspIIRfilters, Buttons, syncobjs, dspFFT, dspTypes, dspWindow, SpecList;

type
  TBars = class(TGraphicControl)
  private
    Bmp: TBitmap;
    BrushBitmap: TBitmap;
  public
    Values: TSpectrumArray;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Reset;
  end;


  TMainForm = class(TForm)
    Timer: TTimer;
    OpenDialog: TOpenDialog;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    Panel1: TPanel;
    PanTrackBar: TTrackBar;
    PanLabel: TLabel;
    VolumeLabel: TLabel;
    ProgressLabel: TLabel;
    BytesLabel: TLabel;
    PlayButton: TButton;
    PauseButton: TButton;
    StopButton: TButton;
    Panel3: TPanel;
    VolumeTrackBar: TTrackBar;
    Panel4: TPanel;
    ProgressTrackBar: TTrackBar;    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Panel5: TPanel;
    DisplayPanel: TPanel;
    Bevel4: TBevel;
    Timer1: TTimer;
    OpenButton: TButton;
    SpeedButton1: TSpeedButton;
    Panel7: TPanel;
    Bevel5: TBevel;
    Panel8: TPanel;
    TBBass: TTrackBar;
    Label2: TLabel;
    Panel18: TPanel;
    TrackBar2: TTrackBar;
    Panel19: TPanel;
    TBTreble: TTrackBar;
    Label12: TLabel;
    LPLeft: TdspIIRFilter;
    LPRight: TdspIIRFilter;
    HPLeft: TdspIIRFilter;
    HPRight: TdspIIRFilter;
    Panel6: TPanel;
    Panel9: TPanel;
    Label3: TLabel;
    Bevel6: TBevel;
    TB1: TTrackBar;
    Panel10: TPanel;
    Label4: TLabel;
    Bevel7: TBevel;
    TB2: TTrackBar;
    Panel11: TPanel;
    Label5: TLabel;
    Bevel8: TBevel;
    TB3: TTrackBar;
    Panel12: TPanel;
    Label6: TLabel;
    Bevel9: TBevel;
    TB6: TTrackBar;
    Panel13: TPanel;
    Label7: TLabel;
    Bevel10: TBevel;
    TB7: TTrackBar;
    Panel14: TPanel;
    Label8: TLabel;
    Bevel11: TBevel;
    TB5: TTrackBar;
    Panel15: TPanel;
    Label9: TLabel;
    Bevel12: TBevel;
    TB4: TTrackBar;
    Panel16: TPanel;
    Label10: TLabel;
    Bevel13: TBevel;
    TB9: TTrackBar;
    Panel17: TPanel;
    Label11: TLabel;
    Bevel14: TBevel;
    TB8: TTrackBar;
    cbClip: TCheckBox;
    Panel20: TPanel;
    TBPreamp: TTrackBar;
    Label13: TLabel;
    FFTLeft: TdspFFT;
    FFTRight: TdspFFT;
    FFTEq: TdspFFT;
    FFTSpectrum1: TdspFFT;
    FFTSpectrum2: TdspFFT;
    PLeftDisp: TPanel;
    PRightDisp: TPanel;
    procedure TimerTimer(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure PlayButtonClick(Sender: TObject);
    procedure PanTrackBarChange(Sender: TObject);
    procedure VolumeTrackBarChange(Sender: TObject);
    procedure PauseButtonClick(Sender: TObject);
    procedure DXSoundFinalize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DisplayPanelResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure TimbreChange(Sender: TObject);
    procedure cbClipClick(Sender: TObject);

  private { Playing sound }
    FUpdating: Boolean;

    DXSound: TDXSound;
    Audio: TdspAudioFileStream;

    procedure CloseSound;
    procedure UpdateInfo;
    procedure UpdateFileInfo;

    procedure ProgressMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ProgressMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private  { sound processing }
    CS: TCriticalSection;

    Clipped: Boolean;
    Preamp: Single;
    PeakGainLeft, PeakGainRight: Single;
    BassGain, TrebleGain: Single;

    SamplesPerSec: Integer;
    BitsPerSample: Integer;
    NumOfChannels: Integer;

    AmpCoeffs: TSpectrumArray;
    OverlapL, OverlapR: PdspSingleArray;
    FilterLen, FilterDataSize: Integer;

    procedure SetupProcessingParameters;
    { Called when the next peace of data is required }
    procedure OnDataRead(var Buffer; Count: Longint);

  private { the display }
    SpectrumValues: TSpectrumList;
    LeftDisp, RightDisp: TBars;
  end;

var
  MainForm: TMainForm;

implementation

uses About;

{$R *.DFM}

type
  TMyTrackBar = class(TTrackBar)
  public
    property OnMouseDown;
    property OnMouseUp;
  end;


constructor TBars.Create(AOwner: TComponent);
begin
  inherited;
  Bmp:= TBitmap.Create;

  BrushBitmap:= TBitmap.Create;
  BrushBitmap.PixelFormat:= pf24bit;
  BrushBitmap.Width:= 8; BrushBitmap.Height:= 8;
  with BrushBitmap.Canvas do
  begin
    Pen.Width:= 2;
    Pen.Color:= $009A6D30;
    Brush.Color:= clBtnFace;
    FillRect(Rect(0, 0, 8, 8));
    MoveTo(-1, 1); LineTo(9, 1);
    MoveTo(-1, 4); LineTo(9, 4);
  end;

  Reset;
end;


destructor TBars.Destroy;
begin
  Bmp.Free;
  BrushBitmap.Free;
  inherited;
end;


procedure TBars.Paint;
var
  I: Integer;
  R: TRect;
  XD: Single;

  function Translate(V: Single): Integer;
  begin
    Result:= -Round(V * Height / 40);
  end;
begin
  Bmp.Width:= Width;
  Bmp.Height:= Height;

  XD:= Width / cNumberOfSpectrumChannels;
  Bmp.Canvas.Brush.Color:= Parent.Brush.Color;
  Bmp.Canvas.FillRect(Rect(0, 0, Width, Height));

  Bmp.Canvas.Brush.Bitmap:= BrushBitmap;
  for I:= 0 to cNumberOfSpectrumChannels - 1 do
  begin
    R.Left:= Round(I*XD); R.Right:= Round(I*XD + XD) - 4;
    R.Bottom:= Height;
    R.Top:= Translate(20 * log10((Values[I] + 1) / High(SmallInt)));
    Bmp.Canvas.FillRect(R);
  end;

  Canvas.CopyRect(ClientRect, Bmp.Canvas, ClientRect);
end;


procedure TBars.Reset;
var I: Integer;
begin
  for I:= Low(Values) to High(Values) do Values[I]:= 0;
end;

{==============================================================================}
{ Player                                                                       }
{==============================================================================}

procedure TMainForm.FormCreate(Sender: TObject);
var I: Integer;
begin
  Application.Title:= 'DSPLab - ' + Caption;

  CS:= TCriticalSection.Create;

  {Create spectrum display}
  LeftDisp:= TBars.Create(Self);
  LeftDisp.Parent:= PLeftDisp;
  LeftDisp.Align:= alClient;

  RightDisp:= TBars.Create(Self);
  RightDisp.Parent:= PRightDisp;
  RightDisp.Align:= alClient;

  SpectrumValues:= TSpectrumList.Create;

  { Initialization for sound processing }

  Clipped:= true;
  Preamp:= 1;
  PeakGainLeft:= 1;
  PeakGainRight:= 1;

  for I:= Low(AmpCoeffs) to High(AmpCoeffs) do AmpCoeffs[I]:= 1;

  { Initialization for sound playing }
  DXSound:= TDXSound.Create(Self);
  DXSound.Options:= [soGlobalFocus];
  DXSound.OnFinalize:= DXSoundFinalize;

  DisplayPanelResize(Self);
  TimbreChange(Self);
  Timer1.Enabled:= true;
  UpdateInfo;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Timer.Enabled:= false;
  Timer1.Enabled:= false;
  CloseSound;
  DXSound.Free;
  CS.Free;
  SpectrumValues.Free;
end;


procedure TMainForm.DXSoundFinalize(Sender: TObject);
begin
  Audio.Free;
  Audio:= nil;
end;


procedure TMainForm.FileOpenClick(Sender: TObject);
var WaveFormat: TWaveFormatEx;
begin
  if not OpenDialog.Execute then Exit;

  CloseSound;

  try
    Caption := Application.Title + ' - ' + ExtractFileName(OpenDialog.FileName);
    DXSound.Initialize;

    { Create the audio stream}
    Audio:= TdspAudioFileStream.Create(DXSound);
    Audio.BufferLength := 1000; // Buffer Length = 1 second
    Audio.FileName     := OpenDialog.FileName;
    Audio.OnDataProcessing:= OnDataRead;

    SamplesPerSec      := Audio.Format^.nSamplesPerSec;
    BitsPerSample      := Audio.Format^.wBitsPerSample;
    NumOfChannels      := Audio.Format^.nChannels;

    {  Setting of format of primary buffer.  }
    MakePCMWaveFormatEx(WaveFormat, 44100, 16, 2);
    DXSound.Primary.SetFormat(WaveFormat);
    SetupProcessingParameters;
    UpdateFileInfo;

    PlayButton.Enabled       := True;
    PauseButton.Enabled      := False;
    StopButton.Enabled       := False;
    PanTrackBar.Enabled      := True;
    VolumeTrackBar.Enabled   := True;
    ProgressTrackBar.Enabled := True;
    ProgressLabel.Enabled    := True;
    BytesLabel.Enabled       := True;

    FUpdating:= true;
    try
      PanTrackBar.Position      := Audio.Pan;
      VolumeTrackBar.Position   := Audio.Volume;
      ProgressTrackBar.Max      := Audio.Size;
      ProgressTrackBar.PageSize := ProgressTrackBar.Max div 25;
      TMyTrackBar(ProgressTrackBar).OnMouseUp:= ProgressMouseUp;
      TMyTrackBar(ProgressTrackBar).OnMouseDown:= ProgressMouseDown;
    finally
      FUpdating:= false;
    end;
  except
    CloseSound;
    raise;
  end;
end;


procedure TMainForm.CloseSound;
begin
  StopButtonClick(nil);
  Timer.Enabled := False;

  DXSound.Finalize;
  Caption:= Application.Title;

  PlayButton.Enabled       := False;
  PauseButton.Enabled      := False;
  StopButton.Enabled       := False;
  PanTrackBar.Enabled      := False;
  VolumeTrackBar.Enabled   := False;
  ProgressTrackBar.Enabled := False;
  ProgressLabel.Enabled    := false;
  BytesLabel.Enabled       := false;

  UpdateInfo;
  UpdateFileInfo;

  FreeMem(OverlapL);
  FreeMem(OverlapR);
end;


procedure TMainForm.PanTrackBarChange(Sender: TObject);
begin
  if FUpdating then Exit;
  Audio.Pan := PanTrackBar.Position * 100;
  UpdateInfo;
end;


procedure TMainForm.VolumeTrackBarChange(Sender: TObject);
begin
  if FUpdating then Exit;
  Audio.Volume := VolumeTrackBar.Position * 100;
  UpdateInfo;
end;


procedure TMainForm.ProgressMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Timer.Enabled:= false;
end;


procedure TMainForm.ProgressMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CS.Acquire;
  try
    SpectrumValues.Clear;
  finally
    CS.Release;
  end;
  Timer.Enabled:= true;
  Audio.Position := ProgressTrackBar.Position;
  UpdateInfo;
end;


procedure TMainForm.PlayButtonClick(Sender: TObject);
begin
  Audio.Play;

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


procedure TMainForm.PauseButtonClick(Sender: TObject);
begin
  Audio.Stop;

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