mmspectr.pas

一套及时通讯的原码

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.ForceRescale;
begin
   SetupXScale;
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.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 _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}

   if (aLength <> FFTLen) then
   begin
      { re-init the FFT instance 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 }
      SetupXScale;
      SetBytesPerSpectrum;
      { Flush the buffers }
      NeedData;
      Invalidate;
   end;
end;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetSampleRate(aValue: Longint);
begin
   if (aValue <> FSampleRate) then
   begin
      FSampleRate := MinMax(aValue, 8000,100000);
      { Re-initialize the display }
      SetupXScale;
      NeedData;
      Invalidate;
   end;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetLogFreq(aValue: Boolean);
begin
   { Toggle between linear and logarithmic frequency scale }
   if (aValue <> FLogFreq) then
   begin
      FLogFreq := aValue;
      SetupXScale;
      NeedData;
      Invalidate;
   end;

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetLogAmp(aValue: Boolean);
begin
   { Toggle linear/logarithmic amplitude axis }
   if (aValue <> FLogAmp) then
   begin
      FLogAmp := aValue;

      if FLogAmp then SetupLogScales
      else SetupLinScales;

      NeedData;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.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 _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetKind(aValue: TMMSpectrumKind);
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      CalcNumSpots;
      ResetPeakValues;
      Invalidate;
   end;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.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
         NeedData;                         { init Data when in designing }
         MMTimeResumeEvent(FTimerID);
      end;
      Invalidate;
   end;
end;

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

   SetupXScale;
   NeedData;
   Invalidate;

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.CalcNumSpots;
begin
   FSpotHeight := Max(FSpotHeight, 1);
   FNumSpots := (FHeight+FSpotSpace) div (FSpotHeight+FSpotSpace);
   if (FNumSpots = 0) then inc(FNumSpots);     { fix divisio by zerro !!! }
   FFirstSpace := (FHeight-(FNumSpots*(FSpotHeight+FSpotSpace)-FSpotSpace)) div 2;

   case FKind of
       skBars,
       skPeaks:
       begin
          { calc the spot on which the next color starts }
          FPoint1Spot := Round((FPoint1 * FNumSpots) / 100);
          FPoint2Spot := Round((FPoint2 * FNumSpots) / 100);
       end;
       skLines,
       skVLines:
       begin
          { calc the point on which the next color starts }
          FPoint1Spot := Round((FPoint1 * FHeight) / 100);
          FPoint2Spot := Round((FPoint2 * FHeight) / 100);
       end;
       skScroll:
       begin
          { calc the point on which the next color starts }
          FPoint1Spot := Round((FPoint1 * FHeight/3) / 100);
          FPoint2Spot := Round((FPoint2 * FHeight/3) / 100);
       end;
       else
       begin
          { calc the point on which the next color starts }
          FPoint1Spot := Round(FHeight-((FPoint1 * FHeight) / 100));
          FPoint2Spot := Round(FHeight-((FPoint2 * FHeight) / 100));
       end;
   end;

   { prepare the second DIB with the inactive spots }
   DrawInactiveSpots;
   { we will see anything in designer or clear out the buffers at runtime }
   NeedData;
end;

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

   if FDrawAmpScale then
      W := Max(W,2*SCALEWIDTH+2*BevelExtend+5);

   if FDrawFreqScale then
      H := Max(H,SCALEHEIGHT+2*BevelExtend+5);
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.AdjustBounds;
var
  W, H: Integer;

begin
   W := Width;
   H := Height;
   AdjustSize(W, H);
   if (W <> Width) or (H <> Height) then SetBounds(Left, Top, W, H)
   else Changed;
end;

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

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.Changed;
begin
   FClientRect := Rect(0,0,Width,Height);

   { make place for the amp scale }
   if FDrawAmpScale then
      InflateRect(FClientRect, -SCALEWIDTH,0);

   { make place for the freq scale }
   if FDrawFreqScale then
      dec(FClientRect.Bottom, SCALEHEIGHT);

   { and now for the bevel }
   InflateRect(FClientRect, -Bevel.BevelExtend, -Bevel.BevelExtend);

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

   { adjust the dyn.array size }
   FreeArrays;
   CreateArrays(FWidth);

   { set the DIB sizes }
   DIBCanvas.SetBounds(0,0,FWidth,FHeight);
   FBarDIB.SetBounds(0,0,FWidth,FHeight);

   { recalculate the number of spots }
   CalcNumSpots;
   { calc the new bytes per Scope }
   SetBytesPerSpectrum;

   { recalc the scalings }
   SetupXScale;

   { init the data buffers }
   NeedData;

   inherited Changed;
end;

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

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

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

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

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

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

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
      SetBytesPerSpectrum;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}