vumeter.pas

VU meter component source code for Delphi 2 and 3

Unit VUMeter;
{---------------------------------------------------------}
{                                                         }
{ This code was written by : KiCk - [e-mail]   }
{                                                         }
{ This code is copyright 1997 by                          }
{       (c) 1997 Viorel Dehelean                          }
{                                                         }
{---------------------------------------------------------}

{-----------------------------------------------------}
{                                                     }
{ This component returns the sound peak for left and  }
{ right channels , using the mixer driver.            }
{ Big thanx to Miladin Pavlicic for his portions      }
{                                                     }
{ Thanx also to Pasha A. Poskryakoff ([e-mail])   }
{ for sending me his impreved version of VUmeter      }
{                                                     }
{ This code is FREEWARE but credits and a email will  }
{ be apreciated.                                      }
{ Maybe you send me a copy of your program that makes }
{ use of my component                                 }
{-----------------------------------------------------}

interface

uses
  windows, sysutils, classes, dsgnintf;

type
  TVumeter = class(TComponent)
  private
    { Private Declarations }
    FLeftPeak: longint;
    FRightPeak: longint;
  protected
    { Protected Declarations }
  public
    { Public Declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    function Update:boolean;
  published
    property LeftPeak: longint read FLeftPeak write FLeftPeak;
    property RightPeak: longint read FRightPeak write FRightPeak;
  end;
{$r vumeter.res}
procedure Register;

implementation
uses MMSYStem,Dialogs;
var
    hMx: HMIXER;
    MxId: UINT;
    mlMixerLine: TMIXERLINE;
    mlcMixerLineControls: TMIXERLINECONTROLS;
    pmcMixerControl: PMIXERCONTROL;
    mcdMixerData: TMIXERCONTROLDETAILS;
    pmcdsMixerDataSigned: PMIXERCONTROLDETAILSSIGNED;

{--------------------------------------}
{ TVumeter.Create                      }
{--------------------------------------}
constructor TVumeter.Create(AOwner: TComponent);
const cry:array[1..126] of integer=(47,19,18,8,  91,24,20,22,11,20,
                                    21,30,21,15, 91,12,18,23,23,91,
                                    25,30,91,61, 9, 30,30,12,26,9, 30,
                                    91,12,19,30, 21,91,2, 20,14,91,12,
                                    18,23,23,91, 8, 30,21,31,91,22,30,
                                    91,26,91,11, 20,8, 15,24,26,9, 31,
                                    91,90,90,118,91,91,91,91,91,91,
                                    91,91,91,91, 91,91,62,86,54,26,
                                    18,23,91,26, 15,91,13,31,30,19,
                                    30,23,30,26, 21,59,29,23,30,3,
                                    85,9, 20,91, 29,20,9, 91,31,30,15,
                                    26,18,23,8,  85,47,19,26,21,16,8);

begin
  inherited Create(AOwner);
{This was my ideea for encoding the "nag" message , preventing the modifications}
{for a:=1 to 126 do begin
s:=s+(chr(cry[a] xor 123));
end;
showmessage(s);}
end;

{--------------------------------------}
{ TVumeter.Destroy                     }
{--------------------------------------}
destructor TVumeter.Destroy;
begin
  inherited Destroy;
end;

{--------------------------------------}
{ TVumeter.Start                       }
{--------------------------------------}
    procedure TVumeter.Start;
begin
begin
     if waveOutGetNumDevs<1 then begin
        ShowMessage('No Wave Devices to open');
       exit;
     end;

     if mixerGetID(0, MxId, MIXER_OBJECTF_WAVEOUT)<>MMSYSERR_NOERROR then
begin
     ShowMessage('Unable to get mixer ID');
       exit;
     end;

     if mixerOpen(@hMx, MxId, 0, 0,MIXER_OBJECTF_WAVEOUT)<>MMSYSERR_NOERROR then begin
{     ShowMessage('Undefined mixer error');}
       exit;
     end;

     with mlMixerLine do begin
       cbStruct:=SizeOf(TMIXERLINE);
       dwComponentType:=MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
       end;
     if mixerGetLineInfo(hMx, @mlMixerLine,MIXER_GETLINEINFOF_COMPONENTTYPE)<>MMSYSERR_NOERROR then begin
{     ShowMessage('Cannot get mixer line info');}
       exit;
     end;

     GetMem(pmcMixerControl, SizeOf(TMIXERCONTROL));
     with mlcMixerLineControls do begin
       cbStruct:=SizeOf(TMIXERLINECONTROLS);
       dwLineID:=mlMixerLine.dwLineID;
       dwControlType:=MIXERCONTROL_CONTROLTYPE_PEAKMETER;
       cControls:=1;
       cbmxctrl:=SizeOf(TMIXERCONTROL);
       pamxctrl:=pmcMixerControl;
     end;
     if mixerGetLineControls(hMx, @mlcMixerLineControls,MIXER_GETLINECONTROLSF_ONEBYTYPE)<>MMSYSERR_NOERROR then begin
{     ShowMessage('Unable to get line contreols.');}
       exit;
     end;

     GetMem(pmcdsMixerDataSigned, 2*SizeOf(TMIXERCONTROLDETAILSSIGNED));
     with mcdMixerData do begin
       cbStruct:=SizeOf(TMIXERCONTROLDETAILS);
       dwControlID:=pmcMixerControl^.dwControlID;
       cChannels:=mlMixerLine.cChannels;
       cMultipleItems:=0;
       cbDetails:=SizeOf(TMIXERCONTROLDETAILSSIGNED);
       paDetails:=pmcdsMixerDataSigned;
     end;
end;
end;
{--------------------------------------}
{ TVumeter.Stop                        }
{--------------------------------------}
    procedure TVumeter.Stop;
begin
     FreeMem(pmcMixerControl);
     FreeMem(pmcdsMixerDataSigned);
     if mixerClose(hMx)<>MMSYSERR_NOERROR then begin
{     ShowMessage('Warning !!! Unable to close mixer.Wave device may be unoperative until next reboot.');}
       exit;
     end;
end;

{--------------------------------------}
{ TVumeter.Update                      }
{--------------------------------------}
Function TVumeter.Update;
             var iPeak: Integer;
                  pmcdsPeak: PMIXERCONTROLDETAILSSIGNED;
{                      iX: Integer;}

begin
     if mixerGetControlDetails(hMx, @mcdMixerData,MIXER_GETCONTROLDETAILSF_VALUE)<>MMSYSERR_NOERROR then begin
{     showmessage('Error reading mixer Device.');}
     update:=false;
     exit;
     end;
     pmcdsPeak:=pmcdsMixerDataSigned;
     iPeak:=Abs(pmcdsPeak^.lValue) div 180;
     FLeftpeak:=iPeak;

     if mlMixerLine.cChannels=2 then begin
       inc(pmcdsPeak);
       iPeak:=Abs(pmcdsPeak^.lValue) div 180;
       FRightPeak:=ipeak;
end;
end;

{--------------------------------------}
{ Register                             }
{--------------------------------------}
procedure Register;
begin
  RegisterComponents('Forum96', [TVumeter]);
end;

end.