mmlight.pas

一套及时通讯的原码

         begin
            Value := PByteArray(PCMData)^[i+i+ReIndex];
            if Value >= 255 then PcmOverflow;
            fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
         end;
      end
      else
      begin
         if (FMode = mMono) then
         for i := 0 to FFTLen-1 do
         begin
            Value := PSmallArray(PCMData)^[i];
            if Value >= 32767 then PcmOverflow;
            fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
         end
         else if (FChannel = chBoth) then
         for i := 0 to FFTLen-1 do
         begin
            Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
            if Value >= 32766 then PcmOverflow;
            fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
         end
         else
         for i := 0 to FFTLen-1 do
         begin
            Value := PSmallArray(PCMData)^[i+i+ReIndex];
            if Value >= 32767 then PcmOverflow;
            fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
         end;
      end;

      { calc the FFT }
      {$IFDEF WIN32}
      DoRealFFT(FpFFT,@fTemp, 1);
      for i := 0 to FFTLen-1 do FFFTData^[i] := Trunc(fTemp[i]/(FFTLen div 2));
      {$ELSE}
      for i := 0 to FFTLen-1 do FFFTData^[i] := fTemp[i];
      FFT.CalcFFT(Pointer(FFFTData));
      {$ENDIF}

      { calc the magnitude }
      CalcMagnitude(False);
      { next, put this data up on the display }
      DrawLight;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.RefreshFFTData(FFTData: Pointer);
begin
   Move(PByte(FFTData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
   { calc the magnitude }
   CalcMagnitude(False);
   { next, put this data up on the display }
   DrawLight;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.RefreshMagnitudeData(MagData: Pointer);
begin
   Move(PByte(MagData)^, FFFTData^, FFTLen*sizeOf(SmallInt));
   { calc display values }
   CalcMagnitude(True);
   { next, put this data up on the display }
   DrawLight;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.CalcMagnitude(MagnitudeForm: Boolean);
var
   i: integer;
   re,im: Long;
   a2,Root: Long;{ Variables for computing Sqrt/Log of Amplitude^2 }

begin
   { go through the data set and convert it to magnitude form }
   inc(FDecayPtr);
   inc(FDecayCntAct);

   if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;

   if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;

   for i := 0 to (FFTLen div 2)-1 do
   begin
      if MagnitudeForm then
      begin
         a2 := PLongArray(FFFTData)^[i];
      end
      else
      begin
         { Compute the magnitude }
         {$IFDEF WIN32}
         re := FFFTData^[i+i];
         im := FFFTData^[i+i+1];
         {$ELSE}
         re := FFFTData^[FFT.BitReversed^[i]];
         im := FFFTData^[FFT.BitReversed^[i]+1];
         {$ENDIF}
         a2 := re*re+im*im;
      end;

      { Watch for possible overflow }
      if (a2 < 0) then a2 := 0;

      Root := Trunc(FAmpScale*sqrt(a2));

      { In decay mode, need to average this value }
      case Ord(FDecayMode) of
         1: begin
               FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor;
               if (Root >= FLastVal_F^[i]) then FLastVal_F^[i] := Root
               else Root := Trunc(FLastVal_F^[i]);
            end;
         2: begin
	       FLastVal_F^[i] := FLastVal_F^[i]*FDecayFactor+(1-FDecayFactor)*Root;
	       Root := Floor(FLastVal_F^[i]);
            end;
         3: begin
               FLastVal^[i] := FLastVal^[i] + (Root-FDataBuf^[FDecayPtr]^[i]);
               FDataBuf^[FDecayPtr]^[i] := Root;
               Root := FLastVal^[i] div FDecayCntAct;
            end;
      end;
      FDisplayVal^[i] := Root;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.CalcDisplayValues;
var
   i, j, k, index: integer;
   dv,val: Longint;
   valf: Float;

begin
   dv := 0;
   j := 0;
   i := 0;
   while i < NumLights do
   begin
      { If this line is the same as the previous one, just use the previous
        Y value. Else go ahead and compute the value. }
      index := Fx1^[i];
      if (index >= 0) then
      begin
         if i > 0 then
         begin
            FValues^[j].CurValue := dv;
            { now the next }
            inc(j);
         end;

         k := 1;
         dv := FDisplayVal^[index];
         valf := dv;

         if (Fx2^[i] > 0) then
         begin
            while (index < Fx2^[i]) do
            begin
               { We have three ways here }
               case FPeakMode of
                 { build the RMS value of the set of bins }
                 pmRMS:
                 begin
                    val := FDisplayVal^[index];
                    valf := valf + (val+0.1)*val;
                 end;
                 { search the higest bin }
                 pmPeak:
                 begin
                    if FDisplayVal^[index] > dv then
                       dv := FDisplayVal^[index];
                 end;
                 { average the bins }
                 pmAverage:
                 begin
                    dv := dv + FDisplayVal^[index];
                    inc(k);
                 end;
               end;
               inc(index);
            end;

            case FPeakMode of
              pmRMS    : dv := Trunc(sqrt(valf/Max(index-Fx1^[i],1)));
              pmPeak   :;
              pmAverage: dv := dv div k;
            end;
         end;
      end;
      inc(i);
   end;
   { store the last value }
   FValues^[j].CurValue := dv;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.InitDIB;
begin
   if (csLoading in ComponentState) then Exit;

   if Kind = lkCircle then
      DIBCanvas.AnimatedColorCount := NumLights
   else
      DIBCanvas.AnimatedColorCount := NumLights * ZoneCount;

   DIBCanvas.DIB_InitDrawing;
                                                      { clear background }
   DIBCanvas.DIB_SetTColor(Color);
   DIBCanvas.DIB_Clear;

   { Flush the buffers }
   InitializeData;

   DrawInitData;

   DIBCanvas.DIB_DoneDrawing;

   Invalidate;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.DrawInitData;
var
    i       : Integer;
    j       : Integer;
    AWidth  : Integer;
    AHeight : Integer;
    ERect   : TRect;
    R       : TRect;
    Delta   : Integer;
    Radius  : Integer;
    Vert    : Boolean;

    procedure DrawCircle(X,Y,W,H: Integer; Color: Integer);
    begin
       with DIBCanvas do
       begin
          DIB_SetColor(AnimatedColorIndex[Color]);
          DIB_FillEllipse(X+W div 2,Y + H div 2,W div 2,H div 2);
       end;
    end;

    procedure DrawZone(X,Y,W,H: Integer; Zone: Integer; Color: Integer);
    var
       HDelta, VDelta: Integer;
    begin
        HDelta := Trunc(Zone * ((W/ZoneCount)/2));
        VDelta := Trunc(Zone * ((H/ZoneCount)/2));

        with DIBCanvas do
        begin
           DIB_SetColor(AnimatedColorIndex[Color]);
           DIB_FillEllipse(X+W div 2,Y+H div 2,(W-HDelta*2) div 2,(H-VDelta*2) div 2);
        end;
    end;

    function EllipseRect(i: Integer ): TRect;
    var
        X, Y: Integer;
    begin
       if Arrange = laLine then
          if Vert then
            Result := Bounds(ERect.Left + Delta, ERect.Top + i*2*Radius + (2*i+1)* Delta, 2*Radius, 2*Radius)
          else
            Result := Bounds(ERect.Left + i*2*Radius + (2*i+1)* Delta, ERect.Top + Delta, 2*Radius, 2*Radius)
       else
       begin
          case i of
             0 : begin X := AWidth div 2 - Radius - Delta; Y := Radius + Delta; end;
             1 : begin X := AWidth div 2; Y := AHeight - Delta - Radius; end;
             2 : begin X := AWidth div 2 + Radius + Delta; Y := Radius + Delta; end;
           else
              Exit; {???}
          end;
          Result := Bounds(X+ERect.Left-Radius,Y+ERect.Top-Radius,2*Radius,2*Radius);
       end;
    end;

begin
    AWidth  := (FClientRect.Right-FClientRect.Left);
    AHeight := (FClientRect.Bottom-FClientRect.Top);
    Delta   := TriangleDist div 2;

    if Arrange = laLine then
    begin
       Vert    := False;
       if AHeight > AWidth then
       begin
          Vert := True;
          if (AHeight div NumLights) > AWidth then
              AHeight := AWidth * NumLights
          else
              AWidth := AHeight div NumLights;

          Radius := ((AHeight div NumLights)) div 2 - Delta;
       end
       else
       begin
          if (AWidth div NumLights) > AHeight then
              AWidth := AHeight * NumLights
          else
              AHeight := AWidth div NumLights;

          Radius := ((AWidth div NumLights)) div 2 - Delta;
       end;
    end
    else
    begin
       if (AWidth > AHeight) then
          AWidth := AHeight;

       Radius  := (AWidth - 4 * Delta) div 4;
       AWidth  := 4*(Radius+Delta);
       AHeight := Trunc((2+Sqrt(3))*(Radius+Delta));
    end;

    if Radius <= 0 then Exit;

    ERect := Bounds(((FClientRect.Right-FClientRect.Left)-AWidth) div 2,
                    ((FClientRect.Bottom-FClientRect.Top)-AHeight) div 2,
                    AWidth, AHeight);

    if (Kind = lkCircle) then
    begin
       for i := 0 to NumLights-1 do
       begin
          R := EllipseRect(i);
          DrawCircle(R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top,i);
       end;
    end
    else
    begin
       for i := 0 to NumLights-1 do
       begin
          R := EllipseRect(i);
          for j := 0 to ZoneCount - 1 do
              DrawZone(R.Left,R.Top,R.Right-R.Left,
                       R.Bottom-R.Top,j,i*ZoneCount+j);
       end;
    end;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.DrawCurrentData;
var
    i       : integer;
    j       : integer;
    Value   : Integer;

    function RGBColor(Index: Integer; Value: Integer): TColor;
    begin
       Result := 0;
       case i of
          0 : Result := RGB(Value,0,0);
          1 : Result := RGB(0,Value,0);
          2 : Result := RGB(Value,Value,0);
       end;
    end;

    function LightColor(i: Integer; Value: Integer): TColor;
    begin
       Result:= RGBColor(i,Value);
    end;

    function ZoneColor(i: Integer; Zone: Integer; Value: Integer): TColor;
    var
       X, Y: Integer;
       ZoneUpper: Integer;
    begin
       X  := (ZoneCount - Zone - 1);
       if X > ZoneCount*SphereHorz then
          X := Trunc(ZoneCount*SphereHorz);
       if (SphereHorz = 0) or (SphereVert = 0) then
          Value := 0
       else
       begin
          Y        := Trunc(Sqrt(Sqr(ZoneCount)-Sqr(X/SphereHorz))*SphereVert);
          ZoneUpper:= Trunc((Y/(ZoneCount*SphereVert))*255);
          Value    := Trunc((Value/255)*ZoneUpper);
       end;
       Result := RGBColor(i,Value);
    end;
begin
   CalcDisplayValues;

   DIBCanvas.BeginAnimate;
   try
      for i := 0 to NumLights - 1 do
      begin
         case i of
              0: Value := Trunc(FValues^[i].CurValue * (FGainBass));
              1: Value := Trunc(FValues^[i].CurValue * (2*FGainMiddle));
              2: Value := Trunc(FValues^[i].CurValue * (4*FGainTreble));
           else  Value := 0;
         end;

         Value := MinMax(Value,0,255);

         if (Value <> FValues^[i].OldValue) then
         begin
            FValues^[i].OldValue := Value;

            with DIBCanvas do
            if Kind = lkCircle then
               AnimatedColorValue[i] := LightColor(i,Value)
            else
               for j := 0 to ZoneCount - 1 do
               AnimatedColorValue[ZoneCount*i+j] := ZoneColor(i,j,Value);
         end;
      end;

   finally
      DIBCanvas.EndAnimate;
   end;
end;

{-- TMMLight ------------------------------------------------------------}
function TMMLight.GetPalette: HPALETTE;
begin
   Result := DIBCanvas.Palette;
end;

{-- TMMLight ------------------------------------------------------------}
procedure TMMLight.DrawLight;
begin
   SelectPalette(Canvas.Handle,DIBCanvas.Palette,True);
   DrawCurrentData;
   DIBCanvas.DIB_BitBlt(Canvas.Handle, FClientRect,0,0);
end;

{-- TMMLight ------------------------------------------------------------}
Procedure TMMLight.Paint;
begin
   { draw the Bevel }
   Bevel.PaintBevel(Canvas, ClientRect,True);

   DrawLight;

   {$IFDEF BUILD_ACTIVEX}
   if Selected then
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Pen.Color   := clRed;
      Canvas.Rectangle(0,0,Width,Height);
      Canvas.Brush.Style := bsSolid;
   end;
   {$ENDIF}
end;

end.