unit fMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uVuMeter, AudioIO, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);

  private
    LeftPeak : Integer;
    RightPeak : Integer;
    PrevLPeak : Integer;
    PrevRPeak : Integer;
    AudioIn : TAudioIn;
    VuMeter : TVuMeter;
    function AudioInBufferFilled(Buffer: PChar; var Size: Integer): Boolean;
  end;

var
  Form1: TForm1;

implementation {$R *.dfm}

type
  TSample = record
    Left : SmallInt;
    Right : SmallInt;
  end;

function TForm1.AudioInBufferFilled(Buffer: PChar; var Size: Integer): Boolean;
  var
    SampleData : ^Cardinal;
    I : Integer;
    Current : TSample;
    PeakL : Integer;
    PeakR : Integer;
    LowL : Integer;
    LowR : Integer;
begin
  SampleData := Pointer(Buffer);
  PeakL := 0;
  PeakR := 0;
  LowL := 0;
  LowR := 0;

  for I := 0 to (Size div sizeof(Integer)) - 1 do
  begin
    Current := TSample(SampleData^);
    Inc(SampleData);

    if (Current.Left > PeakL) then
      PeakL := Current.Left;
    if (Current.Left < LowL) then
      LowL := Current.Left;
    if (Current.Right > PeakR) then
      PeakR := Current.Right;
    if (Current.Right < LowR) then
      LowR := Current.Right;
  end;

  { // This is a direct output method but it's a bit too fast i.m.o.
  LeftPeak :=(PeakL - LowL) div 2;
  RightPeak := (PeakR - LowR) div 2;
  }

  // This method uses an average which gives a smoother effect
  PrevLPeak := (PeakL - LowL) div 2;
  PrevRPeak := (PeakR - LowR) div 2;
  LeftPeak := (PrevLPeak + LeftPeak) div 2;
  RightPeak := (PrevRPeak + RightPeak) div 2;

  // Do whatever necessary to output the new peak values
  VuMeter.LeftPos := LeftPeak;
  VuMeter.RightPos := RightPeak;

  Result := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Create VUMeter and set properties
  VuMeter := TVuMeter.Create(Self);
  with VuMeter do
  begin
    Parent := Self;
    Left := 25;
    Top := 0;
    Height := 335;
    Width := 60;
    Max := 32535;
    Color := clBlack;
  end;

  // Create AudioIn and set properties
  AudioIn := TAudioIn.Create(Self);
  with AudioIn do
  begin
    Stereo := true;
    BufferSize := 4098;
    // Change the Framerate to 44100 for a more faster VU-meter
    FrameRate := 22500;
    NumBuffers := 2;
    Quantization := 16;
    OnBufferFilled := AudioInBufferFilled;
    Start(AudioIn);
  end;
end;

unit uVuMeter;

interface

uses
  Classes, Controls, Graphics, Types;

type
  TVuMeter = class(TGraphicControl)
    private
      fBuffer: TBitmap;
      fLeft: Integer;
      fRight: Integer;
      fMax: Integer;

      procedure fSetValue(Index, Value: Integer);
    protected
      procedure Paint; override;
      procedure DrawVuBar(Left, Top, Value: Integer; Buffer: TBitmap); virtual;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      property LeftPos : Integer index 0 read fLeft write fSetValue;
      property RightPos : Integer index 1 read fRight write fSetValue;
      property Max: Integer read fMax write fMax;
      property Color;
  end;

implementation

constructor TVuMeter.Create(AOwner: TComponent);
begin
  inherited;
  fBuffer := TBitmap.Create;
  fLeft := 0;
  fRight := 0;
end;

destructor TVuMeter.Destroy;
begin
  inherited;
  fBuffer.Free;
end;

procedure TVuMeter.DrawVuBar(Left, Top, Value: Integer; Buffer: TBitmap);
  var
    DigitSize : Integer;
    DigitCount : Integer;
    DigitHeight : Integer;
    DigitWidth : Integer;
    DigitYMarg : Integer;
    I : Integer;
    R : TRect;
begin
  DigitHeight := 4;
  DigitWidth := 15;
  DigitYMarg := 1;
  DigitCount := 60;

  with Buffer.Canvas do
  begin
    R.Left := Left;
    R.Right := Left + Digitwidth;
    R.Top := Top;
    R.Bottom := Top + DigitHeight;

    DigitSize := fMax div DigitCount;

    for I := DigitCount downto 1 do
    begin
      if (I <= Round(DigitCount * 0.60)) then
      begin
        if ((I * DigitSize) < Value) then
          Brush.Color := clLime
        else
          Brush.Color := clGreen;
      end
      else if (I <= Round(DigitCount * 0.80)) then
      begin
        if ((I * DigitSize) < Value) then
          Brush.Color := clYellow
        else
          Brush.Color := clOlive;
      end
      else
      begin
        if ((I * DigitSize) < Value) then
          Brush.Color := clRed
        else
          Brush.Color := clMaroon;
      end;

      FillRect(R);
      R.Top := R.Bottom + DigitYMarg;
      R.Bottom := R.Top + DigitHeight;
    end;
  end;
end;

procedure TVuMeter.Paint;
  var
    R: TRect;
begin
  fBuffer.Width := Width;
  fBuffer.Height := Height;

  R.Left := 0;
  R.Top := 0;
  R.Right := Width;
  R.Bottom := Height;

  with fBuffer.Canvas do
  begin
    Brush.Color := Self.Color;
    FillRect(R);

    Font.Name := 'Verdana';
    Font.Style := [fsBold];
    Font.Color := clWhite;

    TextOut(12, 315, 'L');
    TextOut(37, 315, 'R');

    DrawVuBar(10, 10, fLeft, fBuffer);
    DrawVuBar(35, 10, fRight, fBuffer);
  end;
  Canvas.Draw(0, 0, fBuffer);
end;

procedure TVuMeter.fSetValue(Index, Value: Integer);
begin
  case Index of
    0: // Left
      if (Value <> fLeft) then
      begin
        fLeft := Value;
        Paint;
      end;
    1: // Right
      if (Value <> fRight) then
      begin
        fRight := Value;
        Paint;
      end;
  end;
end;

end.