mmlight.pas

一套及时通讯的原码

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.ResetValues;
var
   i: integer;
begin
   for i := 0 to NumLights-1 do
   begin
      FValues^[i].OldValue := -1;
      FValues^[i].CurValue := 0;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.InitializeData;
Var
   i: integer;

begin
   if Enabled and (csDesigning in ComponentState) then
   begin
      Randomize;
      for i := 0 to FFTLen div 2-1 do
      begin                                         { create random data }
         FDisplayVal^[i] := Long(Random(32767));
      end;
      ResetValues;
   end
   else
   begin                                              { create zero data }
      FillChar(FDisplayVal^[0], FFTLen div 2 * sizeOf(Long), 0);
      FillChar(FFFTData^[0], FFTLen * sizeOf(SmallInt), 0);
      ResetDecayBuffers;
      ResetValues;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.ResetData;
begin
   InitializeData;
   Refresh;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetFFTLen(aLength: integer);
var
   Order: integer;

begin
   aLength := MinMax(aLength,8,MAX_FFTLEN);
   { Convert FFTLen to a power of 2 }
   Order := 0;
   while aLength > 1 do
   begin
      aLength := aLength shr 1;
      inc(Order);
   end;
   if (Order > 0) then aLength := aLength shl Order;

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}

   if (aLength <> FFTLen) then
   begin
      { re-init the FFTObject with the new FFT-length }
      {$IFDEF WIN32}
      DoneRealFFT(FpFFT);
      FpFFT := InitRealFFT(Order);
      FFTLen := aLength;
      GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
      {$ELSE}
      FFT.FFTLength := aLength;
      FFTLen := aLength;
      GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
      {$ENDIF}
      { Re-initialize the display }
      SetupScale;
      SetBytesPerLight;

      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetDecayMode(aValue: TMMDecayMode);
begin
   { Select averaging mode }
   if (aValue <> FDecayMode) then
   begin
      FDecayMode := aValue;
      { Re-initialize the buffers }
      ResetDecayBuffers;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.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;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetWindow(aValue: TMMFFTWindow);
begin
   if (aValue <> FWindow) then
   begin
      FWindow := aValue;
      GenWindowTableInt(FWinBuf,Ord(FWindow),Trunc(Log2(FFTLen)));
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetSampleRate(aValue: Longint);
begin
   if (aValue <> FSampleRate) then
   begin
      FSampleRate := MinMax(aValue, 8000, 100000);
      { Re-initialize the display }
      SetupScale;

      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      { inherited Enabled := Value }
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetKind(aValue: TMMLightKind);
begin
    if (aValue <> FKind) then
    begin
       FKind := aValue;
       InitDIB;
    end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetArrange(aValue: TMMLightArrange);
begin
   if (aValue <> FArrange) then
   begin
      FArrange := aValue;
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetTriangleDist(Value: Integer);
begin
   Value := MinMax(Value,2,MaxInt);
   if (Value <> FTriangleDist) then
   begin
      FTriangleDist := Value;
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetSphereHorz(Value: Float);
begin
   Value := MaxR(Value,0);
   if (Value <> FSphereHorz) then
   begin
      FSphereHorz := Value;
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetSphereVert(Value: Float);
begin
   Value := MaxR(Value,0);
   if (Value <> FSphereVert) then
   begin
      FSphereVert := Value;
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetZoneCount(Value: Integer);
begin
   Value := MinMax(Value,1,MaxInt);
   if (Value <> FZoneCount) then
   begin
      FZoneCount := Value;
      InitDIB;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetPeakMode(aValue: TMMLightPeakMode);
begin
   if (aValue <> FPeakMode) then
   begin
      FPeakMode := aValue;
      Refresh;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.Loaded;
begin
   inherited Loaded;

   SetupScale;

   InitDIB;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.AdjustCtrlSize(var W, H: Integer);
begin
   W := Max(W,2*BevelExtend+5);
   H := Max(H,2*BevelExtend+5);
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
var
  W, H: Integer;

begin
   W := aWidth;
   H := aHeight;
   AdjustCtrlSize (W, H);
   inherited SetBounds(aLeft, aTop, W, H);
   Changed;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.Changed;
begin
   FClientRect := BeveledRect;

   { save the real height and width }
   FWidth  := Max(FClientRect.Right - FClientRect.Left,4);
   FHeight := Max(FClientRect.Bottom - FClientRect.Top,4);

   DIBCanvas.SetBounds(0,0,FWidth,FHeight);

   InitDIB;

   inherited Changed;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetBytesPerLight;
begin
   FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FFTLen;
end;

{-- TMMLight ------------------------------------------------------------}
Procedure TMMLight.SetPCMWaveFormat(wf: TPCMWaveFormat);
var
   pwfx: PWaveFormatEx;

begin
   pwfx := @wf;
   if not pcmIsValidFormat(pwfx) then
      raise EMMLightError.Create(LoadResStr(IDS_INVALIDFORMAT));

   SampleRate := pwfx^.nSamplesPerSec;
   BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
   Mode := TMMMode(pwfx^.nChannels-1);
end;

{-- TMMLight ------------------------------------------------------------}
function TMMLight.GetPCMWaveFormat: TPCMWaveFormat;
var
   wfx: TWaveFormatEx;
begin
   pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
   Result := PPCMWaveFormat(@wfx)^;
end;

{-- TMMLight ------------------------------------------------------------}
Procedure TMMLight.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      SetBytesPerLight;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
Procedure TMMLight.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
      SetBytesPerLight;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
Procedure TMMLight.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) then
   begin
      FMode := aValue;
      SetBytesPerLight;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetAmpScale(index: integer; aValue: integer);
begin
   { Change the amplitude scale factor }
   aValue := MinMax(aValue, 0, 1000);
   if (aValue = GetAmpScale(index)) then exit;

   case index of
      0: FAmpScale  := 0.01*aValue;
      1: FGainBass  := 0.0005*aValue;
      2: FGainMiddle:= 0.0005*aValue;
      3: FGainTreble:= 0.0005*aValue;
   end;

   { Flush the buffers }
   InitializeData;
end;

{-- TMMLight ------------------------------------------------------------}
function TMMLight.GetAmpScale(index: integer): integer;
begin
   case index of
      0: Result := Round(FAmpScale/0.01);
      1: Result := Round(FGainBass/0.0005);
      2: Result := Round(FGainMiddle/0.0005);
      3: Result := Round(FGainTreble/0.0005);
   else
      Result := 0;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.SetupScale;
var
   i,ival: Longint;
   StartFreq: array[0..NumLights-1] of Float;

begin
   if not (csLoading in ComponentState) then
   begin
      { Do RMS averaging into a fixed set of bins }
      StartFreq[0] := 0;
      for i := 1 to NumLights-1 do
	    StartFreq[i] := sqrt(Longint(CenterFreq[i])*CenterFreq[i-1]);

      i := 0;
      while i < NumLights do
      begin
 	    ival := MinMax(Round(StartFreq[i]/FSampleRate*FFTLen),0,FFTLen div 2);
        Fx1^[i] := ival;
        if (i > 0) then Fx2^[i-1] := ival;
        inc(i);
      end;
      Fx2^[i-1] := FFTlen div 2-1;

      { Compute the ending locations for lines holding multiple bins }
      for i := 0 to NumLights-1 do
          if (Fx2^[i] <= (Fx1^[i]+1)) then Fx2^[i] := 0;

      { if lines are repeated on the screen, flag this so that we don't
        have to recompute the y values. }
      for i := NumLights-1 downTo 1 do
      begin
         if (Fx1^[i] = Fx1^[i-1]) then
         begin
      	    Fx1^[i] := -1;
            Fx2^[i]:= 0;
         end;
      end;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.RefreshPCMData(PCMData: Pointer);
var
   Value: Longint;
   i: Integer;
   ReIndex: integer;
   {$IFDEF WIN32}
   fTemp: array[0..MAX_FFTLEN-1] of Float;
   {$ELSE}
   fTemp: array[0..MAX_FFTLEN-1] of Smallint;
   {$ENDIF}

begin
   if FEnabled and Visible then
   begin
      ReIndex := Ord(FChannel)-1;

      { perform windowing on sample Data from PCMData to FFFTData }
      if (FBits = b8bit) then
      begin
         if (FMode = mMono) then
         for i := 0 to FFTLen-1 do
         begin
            Value := PByteArray(PCMData)^[i];
            if Value >= 255 then PcmOverflow;
            fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
         end
         else if (FChannel = chBoth) then
         for i := 0 to FFTLen-1 do
         begin
            Value := (Word(PByteArray(PCMData)^[i+i])+PByteArray(PCMData)^[i+i+1])div 2;
            if Value >= 255 then PcmOverflow;
            fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
         end
         else
         for i := 0 to FFTLen-1 do