mmlevel.pas

一套及时通讯的原码

       property Scale2Color: TColor index 1 read FScale2Color write SetColors default clWhite;
       property Scale3Color: TColor index 2 read FScale3Color write SetColors default clRed;
       property Sensitivy: integer read FSensitivy write SetSensitivy default -35;
       property LogAmp: Boolean read FLogAmp write SetLogAmp default True;
       property Kind: TMMLevelKind read FKind write SetKind default lkHorizontal;
       property Direction: TMMLevelDirection read FDirection write SetDirection default dirNormal;
       property Scale: TMMLevScale read FScale write SetScale;
       property ScalePos: TMMScalePos read FScalePos write SetScalePos default spBoth;
     end;

implementation

{------------------------------------------------------------------------}
procedure TimeCallBack(uTimerID, dwUser: Longint); export;
begin
  if (dwUser <> 0) then
  with TMMCustomLevel(dwUser) do
  begin
     if (FPeak > 0) then
     begin
        dec(FPeakCounter);
        if FPeakCounter <= 0 then
        begin
           if (FPeakSpeed = 0) then
           begin
              FPeak := 0;                          { reset the peak }
              FPeakCounter := 0;
           end
           else
           begin
              dec(FPeak);                          { dec the peak spot }
              FPeakCounter := FPeakSpeed;
           end;
           FRefresh := True;
        end;
     end;
  end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
constructor TMMCustomLevel.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FBarDIB := TMMDIBCanvas.Create(Self);
   FTimerID := 0;
   FRange := $7FFF;                                { 32768 - 16 bit (abs) }
   FEnabled := True;
   FKind := lkHorizontal;
   FDirection := dirNormal;
   FBar1Color := clAqua;
   FBar2Color := clAqua;
   FBar3Color := clRed;
   FInact1Color := clTeal;
   FInact2Color := clTeal;
   FInact3Color := clMaroon;
   FInactiveDoted := False;
   FActiveDoted := False;
   FSpotSpace := 1;
   FSpotWidth := 1;
   FBits := b8Bit;
   FChannel := chBoth;
   FMode := mMono;
   FDrawScale := False;
   FNumPeaks := 1;
   FPeakDelay := 20;
   FPeakSpeed := 0;
   FPeakCounter := 0;
   FData := 0;
   FDecay := 1;
   FDecayMode := dmNone;
   FDecayFactor := 0.0001;
   FDecayCount := 1;
   FDecayCntAct := 0;
   FDecayPtr := 0;
   FCurPeak := 0;
   FPeak := 0;
   FGain := 8;                                    { no Gain = 8 div 8 = 1 }
   FSamples := 50;
   FPoint1 := 50;
   FPoint2 := 85;
   FRefresh := False;
   FSensitivy := -35;
   FLogAmp := True;
   FDCOffsetL := 0;
   FDCOffsetR := 0;
   FDrawReversed := False;

   SetBounds(0,0,200,17);

   Color := clBlack;
   ParentFont := False;
   Font.Name := 'Small Fonts';
   Font.Size := 7;

   SetBytesPerLevel;

   if not (csDesigning in ComponentState) then
   begin
      { create the peak timer }
      FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
   end;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMCustomLevel ------------------------------------------------------}
Destructor TMMCustomLevel.Destroy;
begin
   if (FTimerID <> 0) then
   begin
      { destroy the peak timer }
      MMTimeKillEvent(FTimerID);
   end;
   FBarDIB.Free;

   inherited Destroy;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.ChangeDesigning(aValue: Boolean);
begin
   inherited ChangeDesigning(aValue);

   if not (csDesigning in ComponentState) then
   begin
      { create the peak timer }
      if (FTimerID = 0) then
          FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetBPP(aValue: integer);
begin
   if (aValue <> BitsPerPixel) then
   begin
      if (aValue <> 8) and (aValue <> 24) then
         raise EMMDIBError.Create('Bitlength not supported yet');

      FBarDIB.BitsPerPixel := aValue;
      DIBCanvas.BitsPerPixel := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.GainOverflow;
begin
   if Assigned(FOnGainOverflow) then FOnGainOverflow(Self);
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.PcmOverflow;
begin
   if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.ResetDecayBuffers;
var
   i: integer;

begin
   FDecayPtr := 0;
   FDecayCntAct := 0;      { Restart the count of number of samples taken }
   FLastVal := 0;
   FLastVal_F := 0;
   for i := 0 to MAXDECAYCOUNT-1 do FDataBuf[i] := 0;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.ResetData;
begin
   FPeak := 0;
   FPeakCounter := 0;
   FData := 0;
   FCurPeak := 0;
   ResetDecayBuffers;
   Refresh;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetDecayMode(aValue: TMMDecayMode);
begin
   { Select averaging mode }
   if (aValue <> FDecayMode) then
   begin
      FDecayMode := aValue;
      { Re-initialize the buffers }
      ResetDecayBuffers;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetDecay(aValue: integer);
var
   i: integer;

begin
   aValue := MinMax(aValue,1,16);
   if (aValue <> FDecay) then
   begin
      FDecay := aValue;

      { factor for stepUp and exponential averaging }
      FDecayFactor := 0.0001;
      for i := 0 to FDecay-1 do
          FDecayFactor := sqrt(FDecayFactor);

      { counter for uniform averaging }
      FDecayCount := MinMax(2*(aValue-1),1,MaxDecayCount);

      { Re-initialize the buffers for uniform averaging }
      if (FDecayMode = dmUniform) then ResetDecayBuffers;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetPeakDelay(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 50);
   if (aValue <> FPeakDelay) then
   begin
      FPeakDelay := aValue;
      FPeakCounter := 0;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetPeakSpeed(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 50);
   if (aValue <> FPeakSpeed) then
   begin
      FPeakSpeed := aValue;
      FPeakCounter := 0;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetNumPeaks(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 5);
   if (aValue <> FNumPeaks) then
   begin
      FNumPeaks := aValue;
      FPeakCounter := 0;
      if (FNumPeaks = 0) then
         MMTimeSuspendEvent(FTimerID)
      else if FEnabled then
         MMTimeResumeEvent(FTimerID);

      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      { inherited Enabled := Value }
      if (not FEnabled) then
      begin
         ResetData;
         MMTimeSuspendEvent(FTimerID);
      end
      else
      begin
         CalcNumSpots;                     { init FData when in designing }
         MMTimeResumeEvent(FTimerID);
      end;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetKind(aValue: TMMLevelKind);
var
   Temp: integer;
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      if ((FKind = lkHorizontal) and (Height > Width)) or
         ((FKind = lkVertical) and (Height < Width)) then
      begin
         Temp := Width;
         Width := Height;                        { swap Width and Height }
         Height := Temp;
      end;
      Changed;                                    { recalc the dimension }
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetDirection(aValue: TMMLevelDirection);
Begin
   if (aValue <> FDirection) then
   begin
      FDirection := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetSpotSpace(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 10);
   if (aValue <> FSpotSpace) then
   begin
      FSpotSpace := aValue;
      CalcNumSpots;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetSpotWidth(aValue: integer);
Var
   Temp: integer;

begin
   Temp := 0;
   case FKind of
      lkHorizontal: Temp := FWidth div 3;
      lkVertical  : Temp := FHeight div 3;
   end;

   aValue := MinMax(aValue, 1, Temp);
   if (aValue <> FSpotWidth) then
   begin
      FSpotWidth := aValue;
      CalcNumSpots;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetSensitivy(aValue: integer);
begin
   aValue := MinMax(aValue, -90, -9);
   if (aValue <> FSensitivy) then
   begin
      FSensitivy := aValue;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetLogAmp(aValue: Boolean);
begin
   if (aValue <> FLogAmp) then
   begin
      FLogAmp := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.CalcNumSpots;
begin