mmspectr.pas

一套及时通讯的原码

         im := 0;
      end
      else
      begin
         {$IFDEF WIN32}
         re := FFFTData^[2*index];
         im := FFFTData^[2*index+1];
         {$ELSE}
         re := FFFTData^[FFT.BitReversed^[index]];
         im := FFFTData^[FFT.BitReversed^[index]+1];
         {$ENDIF}
      end;

      amp := sqrt(re*re+im*im)/32768.0;

      if (FGain3db > 0) then
         amp := amp * sqrt((index+1)*FSampleRate/FFTLen/FRefFreq);

      if (FDeriv = 1) then
         amp := amp * FSampleRate/(2*M_PI*FRefFreq);

      if (FDeriv = 2) then
         amp := amp * FSampleRate/(2*M_PI*FRefFreq)
	            * FSampleRate/(2*M_PI*FRefFreq);

      if (amp <> 0) and (FPeak.Amplitude > 0) then
      begin
         db := 20*log10(amp);
         if FLogFreq then
         begin
            if index <= 1 then Freq := (index+0.25) * FSampleRate/FFTLen
            else Freq := index * FSampleRate/FFTLen;
         end
         else Freq := (index+0.5) * FSampleRate/FFTLen;
      end
      else
      begin
         amp := 0;
         db := -100;
         Freq := 0;
      end;
   end;
   Result := FPeak;
end;

{-- TMMSpectrum ---------------------------------------------------------}
{ Set up logarithmic amplitude (Y) scale factors and offsets. }
procedure TMMSpectrum.SetupLogScales;
var
   i: integer;
   Scale,Base,Convert,Offset: Float;

begin
   if not(csLoading in ComponentState) then
   begin
      { Compute the (logarithmic) y scale factor and offset.
        This may include a 3dB/octave gain.

        Conversion factor from db/10 to dPhils (the computed "unit")
        where a factor of 2 yields 16384 dPhils (6.02dB)
        Scaling factor is such that  32768 ->   0.00 dB -> 245760 dPhils
                                and      2 -> -84.29 dB ->  16384 dPhils
                                and      1 -> -90.31 dB ->      0 dPhils
        i.e. dPhils=16384.0/log(2) * log(value)
        and changes of 6.02 dB = 16384 dPhils }

      Convert := 819.2*log(10)/log(2); { Scale for dB to dPhils conversion  }
      Offset := log10(32768)*20;       { Offset for db to dPhils conversion }

      { This value is used in the main program group to convert squared values
        amplitudes to dPhils using dPhils = log(value^2)*Log_ScaleFactor }

      FLogScaleFactor := 8192.0/log(2);

      Scale := FHeight/(10*(FLogBase-FLogs)*Convert);
      if (FDeriv = 0) then
         Base := (Offset-FLogBase*10)*Convert
      else if(FDeriv = 1) then
         Base := (Offset-log10(FSampleRate/(2*M_PI*FRefFreq))*20-FLogBase*10)*Convert
      else
         Base := (Offset-log10(FSampleRate/(2*M_PI*FRefFreq))*40-FLogBase*10)*Convert;

      FDispScaleFactor := Scale; { Save the unshifted version for avg. display mode }

      FShift := 0;

      {  Make maximum use of available bits
         (use only 12 bits--other 4 used for higher resolution in the data) }

      while (Scale < 4096) do
      begin
         Scale := Scale*2;
         inc(FShift);
      end;

      for i := 0 to FWidth-1 do
          FYScale^[i] := Floor(Scale+0.5);

      if (FGain3db > 0) then
      begin
         for i := 0 to (FFTLen div 2)-1 do
	     FYBase^[i] := Floor(0.5+Base-log10((i+1)*FSampleRate/FFTLen/FRefFreq)*Convert*10);
      end
      else
      begin
         for i := 0 to (FFTLen div 2)-1 do
	     FYBase^[i] := Floor(0.5+Base);
      end;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
{ Set up linear amplitude (Y) scale factors }
procedure TMMSpectrum.SetupLinScales;
var
   i: integer;
   Scale: Float;

begin
   if not(csLoading in ComponentState) then
   begin
      { Compute the (linear) y scale factor.
        This may include  a 3dB/octave gain. }

      Scale := FHeight/(Fys*32768.0*sqrt(FRefFreq));

      FShift := 4; { Display data has an extra factor of 16 for better resolution }

      if (FDeriv = 1) then
      begin
         Scale := Scale*FSampleRate/(2*M_PI*FRefFreq);
      end
      else if (FDeriv = 2) then
      begin
         Scale := Scale*FSampleRate*FSampleRate/(4*M_PI*M_PI*FRefFreq*FRefFreq);
      end;

      { Make maximum use of available bits }
      if (FGain3db > 0) then
      begin
         { Make maximum use of available bits
         (use only 12 bits--other 4 used for higher resolution in the data) }

         while Scale*sqrt(FSampleRate/2) < 4096 do
         begin
	    Scale := Scale*2;
	    inc(FShift);
         end;

         for i := 0 to FWidth-1 do
         begin
	    if (Fx1^[i] = -1) then FYScale^[i] := 0
	    else FYScale^[i] := Round(Scale*sqrt((Fx1^[i]+1)*FSampleRate/FFTLen)+0.5);
         end;
      end
      else
      begin
         { Make maximum use of available bits
         (use only 12 bits--other 4 used for higher resolution in the data) }
         Scale := Scale*sqrt(FRefFreq);
         while (Scale < 4096) do
         begin
	    Scale := Scale*2;
	    inc(FShift);
         end;

         for i := 0 to FWidth-1 do
         begin
	    if (Fx1^[i] = -1) then FYScale^[i] := 0
	    else FYScale^[i] := Floor(Scale+0.5);
         end;
      end;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.XRangeCheck;
var
   MaxBase: Float;

begin
   FFreqScaleFactor := MinMaxR(FFreqScaleFactor, 1.0, 16.0);

   if FLogFreq then
   begin
      MaxBase := FSampleRate/2/exp(log(FFTLen/2)/FFreqScaleFactor);
      FFreqBase := MinMaxR(FFreqBase, FSampleRate/FFTLen, MaxBase);
   end
   else
   begin
      FFreqBase := MaxR(FFreqBase, 0);
      if ((FFreqBase+FSampleRate/(2*FFreqScaleFactor))>FSampleRate/2) then
	 FFreqBase := FSampleRate/2-FSampleRate/(2*FFreqScaleFactor);
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
{ Set up X axis scales }
procedure TMMSpectrum.SetupXScale;
var
   i,ival: Long;

begin
   if not(csLoading in ComponentState) then
   begin
      { Do some range checking on the base and scale factors }
      XRangeCheck;

      if assigned(FOnGetXScale) then FOnGetXScale(Self,Fx1,Fx2)
      else
      begin
         { Initialize graph x scale (linear or logarithmic).
           This array points to the bin to be plotted on a given line.}

         for i := 0 to FWidth-1 do
         begin
            if FLogFreq then
               ival := Floor(FFTLen*FFreqBase/FSampleRate*exp((i-0.45)/
                             FWidth*Log((FFTLen+1)/2)/FFreqScaleFactor)+0.51)-1
            else
               ival := Floor((i/FWidth*FFTLen/2.0/FFreqScaleFactor)+
                             (FFreqBase/FSampleRate*FFTLen)+0.01);

            ival := MinMax(ival,0,(FFTLen div 2)-1);

            Fx1^[i] := ival;
            if (i > 0) then Fx2^[i-1] := ival;
         end;

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

      { If lines are repeated on the screen, flag this so that we don't
        have to recompute the y values. }

      for i := FWidth-1 downTo 1 do
      begin
         if (Fx1^[i] = Fx1^[i-1]) then
         begin
            Fx1^[i] := -1;
            Fx2^[i]:= 0;
         end;
      end;

      if FLogAmp then SetupLogScales
      else SetupLinScales;

      DrawInactiveSpots;

      if not (csDesigning in ComponentState) then
         FastDraw(DrawFrequencyScale,True)
      else
         Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetFrequencyAtPos(Pos: TPoint): Float;
var
   Step: Float;

begin
   Result := 0;
   if PtInRect(FClientRect,Pos) then
   begin
      dec(Pos.X,FClientRect.Left);
      if (FLogFreq) then
      begin
         Step := log(FFTLen/2)/((FWidth-1)*FFreqScaleFactor);
         Result := MaxR(FFreqBase*exp(Pos.X*Step),0);
      end
      else
      begin
         Step := (FSampleRate/2-FFreqBase)/(FWidth-1)/FFreqScaleFactor;
         Result := MaxR(FFreqBase+Pos.X*Step,0);
      end;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetAmplitudeAtPos(Pos: TPoint): Float;
begin
   Result := 0;
   if PtInRect(FClientRect,Pos) then
   begin
      dec(Pos.Y,FClientRect.Top);
      if FLogAmp then
         Result := (Pos.Y*((FLogBase-FLogs)/(FHeight-1))+FLogs)*-10
      else
         Result := (FHeight-Pos.Y-1)*(10/(FHeight-1))*Fys*0.1;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetScaleBackColor: TColor;
begin
   {$IFNDEF BUILD_ACTIVEX}
   Result := TForm(Parent).Color;
   {$ELSE}
   Result := FScaleBackColor;
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.DrawFrequencyScale(Dummy: Boolean);
var
   aBitmap: TBitmap;
   i, X: integer;
   Step, Freq: Float;
   Text: String;
   NumSteps: integer;

begin
   if FDrawFreqScale then
   begin
      aBitmap := TBitmap.Create;
      try
         aBitmap.Width := FWidth + 2*BevelExtend;
         aBitmap.Height := SCALEHEIGHT;
         aBitmap.Canvas.Font.Color := FScaleTextColor;
         aBitmap.Canvas.Pen.Color := FScaleLineColor;
         aBitmap.Canvas.Brush.Color := GetScaleBackColor;
         with aBitmap.Canvas do
         begin
            FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));

            { calc the number of steps required }
            NumSteps := 32;
            while (FWidth div NumSteps < SCALEFONTSIZE) do
            begin
               NumSteps := NumSteps div 2;
               if NumSteps = 1 then break;
            end;

            { Put up the frequency scale. }
            if (FLogFreq) then
                Step := log(FFTLen/2)/(NumSteps*FFreqScaleFactor)
            else
                Step := (FSampleRate/2-FFreqBase)/NumSteps/FFreqScaleFactor;

            MoveTo(BevelExtend,0);
            for i := 0 to NumSteps do
            begin
               X := BevelExtend + Round(i * (FWidth-1)/NumSteps);
               LineTo(X, 0);
               LineTo(X, 3);
               MoveTo(X, 0);
               if (FLogFreq) then
                   Freq := MaxR(FFreqBase*exp(Step*i),0)
               else
                   Freq := MaxR(FFreqBase+i*step,0);

               Text := Format('%.0f',[Freq]);
               TextOutAligned(aBitmap.Canvas,X,6,Text,SCALEFONT,SCALEFONTSIZE,2);{ vertical text }
            end;
         end;
         Canvas.Draw(FClientRect.Left-BevelExtend,
                     FClientRect.Bottom+BevelExtend+3, aBitmap);

      finally
         aBitmap.Free;
      end;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.DrawAmplitudeScale;
var
   aBitmap: TBitmap;
   i, X, Y, H: integer;
   Text: String;
   Scale: Float;
   NumSteps: integer;

begin
   { Put up the amplitude scale }
   if FDrawAmpScale then
   begin
      aBitmap := TBitmap.Create;
      try
         if FdrawFreqScale then
            H := Height-ScaleHeight
         else
            H := Height;

         aBitmap.Width := SCALEWIDTH;
         aBitmap.Height := H;
         aBitmap.Canvas.Font.Color := FScaleTextColor;
         aBitmap.Canvas.Pen.Color := FScaleLineColor;
         aBitmap.Canvas.Brush.Color := GetScaleBackColor;
         with aBitmap.Canvas do
         begin
            if (LogAmp) then
            begin
               { calc the number of steps required }
               NumSteps := (FLogBase-FLogs);
               while (FHeight div NumSteps < SCALEFONTSIZE) do
               begin
                  dec(NumSteps);
                  if NumSteps <= 1 then break;
               end;

               { draw the left side }
               FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));