mmspgram.pas

一套及时通讯的原码

              end;
              spBlackWhite:
              begin
                 palEntry[i].peRed := clr;
                 palEntry[i].peGreen := clr;
                 palEntry[i].peBlue := clr;
              end;
              spWhiteBlack:
              begin
                 palEntry[i].peRed := 255-clr;
                 palEntry[i].peGreen := 255-clr;
                 palEntry[i].peBlue := 255-clr;
              end;
            end;
         end;
      end;
      SetPalette(@LogPal);
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetupYScale;
var
   i,ival: Long;
   FFTBase: Float;

begin
   { Setup Y axis }
   if not(csLoading in ComponentState) then
   begin
      { Do some range checking on the base and scale factors }
      FFreqBase := MinMaxR(FFreqBase,0,FSampleRate/2-1000);
      if FFreqBase+(FSampleRate/2-FFreqScaleFactor*FFreqBase)/FFreqScaleFactor > FSampleRate/2 then
	 FFreqBase := FSampleRate/2-(FSampleRate/2-FFreqScaleFactor*FFreqBase)/FFreqScaleFactor-1000;

      FFTBase := FFreqBase/FSampleRate*FFTLen;

      { Initialize graph y scale (linear or logarithmic).
        This array points to the bin to be plotted on a given row.}
      for i := 0 to FHeight-1 do
      begin
         ival := Floor(0.01+FFTBase+(i/FHeight*
                        (FFTLen/2-FFreqScaleFactor*FFTBase))/FFreqScaleFactor);
         ival := MinMax(ival,0,FFTLen div 2-1);

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

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

      { if lines are repeated on the screen, flag this so that we don't
        have to recompute the y values. }
      for i := FHeight-1 downTo 1 do
      begin
         if (Fy1^[i] = Fy1^[i-1]) then
         begin
      	    Fy1^[i] := -1;
	    Fy2^[i]:= 0;
         end;
      end;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.RefreshPCMData(PCMData: Pointer);
var
   Value: Longint;
   i: Integer;
   ReIndex: integer;
   Back1, Back2: Long;                       { Variables for differencing }
   {$IFDEF WIN32}
   fTemp: array[0..MAX_FFTLEN] of Float;
   {$ELSE}
   fTemp: array[0..MAX_FFTLEN] of Smallint;
   {$ENDIF}

begin
   if FEnabled and Visible and not FShowInfoHint then
   begin
      ReIndex := Ord(FChannel)-1;
      if (FGain = sgrNone) then
      begin
         { perform windowing on sample Data from PCMData to FFFTData }
         if (FBits = b8bit) then
            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
            begin
               Value := PByteArray(PCMData)^[i+i+ReIndex];
               if Value >= 255 then PcmOverflow;
               fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
            end
         else
            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
      else if (FGain = sgr6db) then
      begin
         { perform windowing on sample Data from PCMData to FFFTData }
         if (FBits = b8bit) then
         begin
            if (FMode = mMono) then
            begin
               Back1 := PByteArray(PCMData)^[0];
               for i := 0 to FFTLen-1 do
               begin
                  Value := PByteArray(PCMData)^[i];
                  if Value >= 255 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
                  Back1 := Value;
               end;
            end
            else if (FChannel = chBoth) then
            begin
               Back1 := PByteArray(PCMData)^[0];
               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-Back1,FWinBuf^[i],128);
                  Back1 := Value;
               end;
            end
            else
            begin
               Back1 := PByteArray(PCMData)^[ReIndex];
               for i := 0 to FFTLen-1 do
               begin
                  Value := PByteArray(PCMData)^[i+i+ReIndex];
                  if Value >= 255 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],128);
                  Back1 := Value;
               end;
            end;
         end
         else
         begin
            if (FMode = mMono) then
            begin
               Back1 := PSmallArray(PCMData)^[0];
               for i := 0 to FFTLen-1 do
               begin
                  Value := PSmallArray(PCMData)^[i];
                  if Value >= 32767 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
                  Back1 := Value;
               end;
            end
            else if (FChannel = chBoth) then
            begin
               Back1 := PSmallArray(PCMData)^[0];
               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-Back1,FWinBuf^[i],32768);
                  Back1 := Value;
               end;
            end
            else
            begin
               Back1 := PSmallArray(PCMData)^[ReIndex];
               for i := 0 to FFTLen-1 do
               begin
                  Value := PSmallArray(PCMData)^[i+i+ReIndex];
                  if Value >= 32767 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-Back1,FWinBuf^[i],32768);
                  Back1 := Value;
               end;
            end;
         end;
      end
      else { Deriv = 2 }
      begin
         { perform windowing on sample Data from PCMData to FFFTData }
         if (FBits = b8bit) then
         begin
            if (FMode = mMono) then
            begin
               Back1 := PByteArray(PCMData)^[0];
               Back2 := Back1;
               for i := 0 to FFTLen-1 do
               begin
                  Value := PByteArray(PCMData)^[i];
                  if Value >= 255 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end
            else if (FChannel = chBoth) then
            begin
               Back1 := PByteArray(PCMData)^[0];
               Back2 := Back1;
               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-2*Back1+Back2,FWinBuf^[i],128);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end
            else
            begin
               Back1 := PByteArray(PCMData)^[ReIndex];
               Back2 := Back1;
               for i := 0 to FFTLen-1 do
               begin
                  Value := PByteArray(PCMData)^[i+i+ReIndex];
                  if Value >= 255 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],128);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end;
         end
         else
         begin
            if (FMode = mMono) then
            begin
               Back1 := PSmallArray(PCMData)^[0];
               Back2 := Back1;
               for i := 0 to FFTLen-1 do
               begin
                  Value := PSmallArray(PCMData)^[i];
                  if Value >= 32767 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end
            else if (FChannel = chBoth) then
            begin
               Back1 := PSmallArray(PCMData)^[0];
               Back2 := Back1;
               for i := 0 to FFTLen-1 do
               begin
                  Value := (Long(PSmallArray(PCMData)^[i+i])+PSmallArray(PCMData)^[i+i+1])div 2;
                  if Value >= 32767 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end
            else
            begin
               Back1 := PSmallArray(PCMData)^[ReIndex];
               Back2 := Back1;
               for i := 0 to FFTLen-1 do
               begin
                  Value := PSmallArray(PCMData)^[i+i+ReIndex];
                  if Value >= 32767 then PcmOverflow;
                  fTemp[i] := MulDiv32(Value-2*Back1+Back2,FWinBuf^[i],32768);
                  Back2 := Back1;
                  Back1 := Value;
               end;
            end;
         end;
      end;

      fTemp[FFTLen] := 0;

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

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

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

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

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.CalcMagnitude(MagnitudeForm: Boolean);
var
   i: integer;
   re,im: Long;
   a2: Longint;
   pSave: PLongArray;

begin
   { go through the data set and convert it to magnitude form }
   if FSaveData then
      pSave := Pointer(PChar(FSaveBuffer) + Fx2*(FFTLen div 2)*sizeof(Long))
   else
      pSave := nil;

   if not FLogAmp then
   begin
      { Use sqrt(a2) in linear-amplitude mode }
      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;
         FDisplayVal^[i] := Trunc((FAmpScale*sqrt(a2))+(-90-FSensitivy))+MIN_COLOR;
         if (pSave <> nil) then
             pSave[i] := FDisplayVal^[i];
      end;
   end
   else
   begin { log-amplitude mode }
      for i := 0 to (FFTLen div 2)-1 do
      begin
         if MagnitudeForm then
         begin
            a2 := PLongArray(FFFTData)^[i];
         end
         else
         begin