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

[WS1976]

Hallo,

und die Unit AudioIO wo ist die?

Grüsse
Rainer

[S4SH1981]

[edit=Matze]Unit im Anhang untergebracht. Da scrollt man sonst so lange. MfG, Matze[/edit]

[Matze]

Hi,

@Rainer: Ich denke nicht, dass diese Unit von Bedeutung ist, sondern vermute, dass man hier die Parameter tauschen oder andere Änderungen in den Prozeduren durchführen muss:

Delphi-Quellcode:

procedure TVuMeter.DrawVuBar(Left, Top, Value: Integer; Buffer: TBitmap);
procedure TVuMeter.Paint;

@S4SH1981: Ich konnte auf Anhieb keine Lizenz finden. Auch wenn es die Unit kostenlos zum Herunterladen gibt, darf man diese hier anhängen?

[pstruh]

Hallo Zusammen!
Ich fürchte, jetzt fehlt noch die Unit UAFDefs (oder ist das 'ne Delphi Unit einer höheren Version?) - Ohne es jetzt ausprobieren zu können: Ich denke, dass eine Anpassung in der Unit uVuMeter in den Prozeduren "DrawVuBar" und "Paint" den gewünschten Effekt haben wird >> die Angaben für Left, Right, Top und Bottom müssen entsprechend angepasst werden (am Besten optional, damit man künftig wahlweise horizontale wie auch vertikale VU-Meter anzeigen lassen kann)

[S4SH1981]

Hier nun die UAFDefs Unit

Delphi-Quellcode:

unit UAFDefs;

               interface
               
{------------------------type defintions-----------------------}

Type
   UAF_FILE_TYPE =
        (UAF_TYPE_UNKNOWN,       { Invalid or Unknow File }
         UAF_TYPE_ADF,           { Bliss Audio Data Files }
         UAF_TYPE_WAV,           { Microsoft RIFF wav Files }
         UAF_TYPE_AU,            { Sun AU file format }
         UAF_TYPE_AIFF,          { Apple Wave format }
         UAF_TYPE_RAW);          { Raw input stream }

Type
   UAF_File = Record
     FrameRate     : Double;
     Channels      : Word;
     Quantization  : Word;
     Frames        : LongInt;
     FrameSize     : Word;
     FileRecord    : Pointer;
     FileType      : UAF_FILE_TYPE;
     SubType       : Integer;
     FrameSizeIn   : Word;         { Just the input frame size }
   End;

{---------------------Function and subroutines------------------------}

   Function UAF_open
      (
         Var uaf    : uaf_file;        { ADF handle                   }
         fname     : String;           { File name to open            }
         mode      : char;             { r,w for Read Write           }
         ForceType : UAF_FILE_TYPE     { If non-zero, force the type  }
      ) : Boolean; external 'uafdll.dll';

   Function UAF_create
      (
         Var uaf   : uaf_file;         { ADF handle                 }
         fname     : String;           { File name to open          }
    ftype     : UAF_FILE_TYPE;    { Type of audio file         }
         subformat : Word;             { Subtype                    }
         srate     : Double;           { Sampling rate              }
         nchannels : Word;             { Channels 1 or 2            }
         bits      : Word              { Bits /sample               }
      ) : Boolean;  external 'uafdll.dll';

   Function UAF_close
      (
         var uaf  : uaf_file        { ADF handle                }
       ) : Boolean; external 'uafdll.dll';

   Function UAF_read
      (
         Var uaf    : uaf_file;         { ADF handle                }
         buffer     : Pointer;          { Buffer                    }
         nFrames    : LongInt;          { how many words            }
         lpos       : LongInt           { Position to read          }
      ) : LongInt; external 'uafdll.dll';

   Function UAF_write
      (
         Var uaf    : uaf_file;         { ADF handle                }
         buffer     : Pointer;            { Buffer                    }
         nFrames    : LongInt;          { how many words            }
         lpos       : LongInt           { Position to read          }
      ) : LongInt;  external 'uafdll.dll';


   Function UAF_CreateFromUAF(Var uafin, uafout : uaf_file; fname : String) : Boolean;
external 'uafdll.dll';
   Function UAF_SaveSection(Var uafin, uafout : uaf_file; lstart, lend : LongInt) : Boolean;
external 'uafdll.dll';
   Procedure UAF_Copy_Marks(Var uafin, uafout  : uaf_file);
external 'uafdll.dll';
   Function FindMinMaxUAF(FileIn : String; Var Min, Max : Real; OverrideType : UAF_FILE_TYPE) : Boolean;
external 'uafdll.dll';
   Function UAFTypeFromExtension (fname : String) : UAF_FILE_TYPE;
external 'uafdll.dll';
   Function UAF_ErrorMessage : PChar; External 'uafdll.dll';

   Function UAF_Identity(UAFIn : UAF_File) : PChar; External 'uafdll.dll';
   Function UAF_Description(UAFIn : UAF_File) : PChar; External 'uafdll.dll';

implementation

end.

P.S. Großes Lob an euch für Eure schnelle Hilfe.

[S4SH1981]

Hallo Leute,

auf dem Weg ein VU Meter zu basteln habe ich auf der Seite h**p://www.picsoft.de/compon.htm
die RackControl Komponente gefunden.

Mit dieser ist es möglich, eine horizontales wie von mir gewünscht, oder aber auch
ein vertikales VU Meter herzustellen.

Wenn ich unter Delphi 7 die Demo starten möchte, fängt es erstmal mit Fehlermeldungen an.
Klasse TLedButton nicht gefunden 3x
Klasse TButtonPanel nicht gefunden 6x
Klasse TLedmeter nicht gefunden 2 x

Für mich ist allerdings auch nur die TLedMeter Klasse erstmal wichtig.


Wie komme ich dazu, dass Delphi die Klasse TLEDMeter findet und in das Prog auch nutzen kann?

Danke schonmal für eure schnelle Antwort.

[Cyberbob]

Neue Frage -> Neuer Thread!

Aber schau mal bei torry.net vorbei, ich meine, da mal was gesehen zu haben.