VU Meter

[S4SH1981]

Nabend Leute,

habe hier mal einen schönen Quelltext gefunden, der mir ein VU Meter auf den Bildschirm zaubert.
Ich hätte den nur gerne horizontal und nicht wie programmiert in vertikal.

Delphi-Quellcode:

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;

und

Delphi-Quellcode:

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.

Schonmal danke fürs drübergucken und einer eventuellen Hilfe