mmspectr.pas

一套及时通讯的原码

   {$ENDIF}
   {$ENDIF}
end;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetRefFreq(aValue: integer);
begin
   aValue := MinMax(aValue,1,44100);
   if (aValue <> FRefFreq) then
   begin
      FRefFreq := aValue;

      if LogAmp then SetupLogScales
      else SetupLinScales;

      { Re-initialize the buffers }
      ResetPeakValues;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetGain(aValue: TMMSpectrumGain);
begin
   if (aValue <> FGain) then
   begin
      FGain := aValue;

      FDeriv := Ord(FGain) div 2;
      FGain3db := Ord(FGain) - FDeriv * 2;

      if LogAmp then SetupLogScales
      else SetupLinScales;

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

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetVertScale;
begin
   { Change the vertical scale factor }
   aValue := MinMax(aValue, 1, 500);
   if (aValue <> GetVertScale) then
   begin
      Fys := 0.01 * aValue;
      if LogAmp then SetupLogScales
      else SetupLinScales;
{TODO: !!!}
      (* VK_UP: Increase the vertical scale factor }
      if LogAmp then
      begin
         if (Log_Base < 10) then
         begin
            inc(Logs, 1);
            inc(Log_Base, 1);
            if (Log_Base > 10) then
            begin
               Logs := Logs - (Log_Base-10);
               Log_Base := 10;
            end;
            Setup_LogScales;
         end;
      end;
      VK_DOWN: { Decrease the vertical scale factor }
      if LogAmp then
      begin
         if (Logs > 0) then
         begin
            dec(Logs, 1);
            dec(Log_Base, 1);
            if (Logs < 0) then
            begin
               dec(Log_Base, Logs);
               Logs := 0;
            end;
            Setup_LogScales;
         end;
      end*)
      ResetPeakValues;
      Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetVertScale: integer;
begin
   Result := Round(Fys / 0.01);
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetFreqScale(aValue: integer);
var
   i: integer;

begin
   aValue := MinMax(aValue,1,16);
   { Convert scale to a power of 2 }
   i := 0;
   while aValue > 1 do
   begin
      aValue := aValue shr 1;
      inc(i);
   end;
   if (i > 0) then aValue := aValue shl i;

   if (aValue <> Trunc(FFreqScaleFactor)) then
   begin
      FFreqScaleFactor := aValue;
      { Re-initialize the display }
      SetupXScale;
      NeedData;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetFreqScale: integer;
begin
   Result := Trunc(FFreqScaleFactor);
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetDrawFreqScale(aValue: Boolean);
begin
   if (aValue <> FDrawFreqScale) then
   begin
      FDrawFreqScale := aValue;
      AdjustBounds;
      Refresh;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetDrawAmpScale(aValue: Boolean);
begin
   if (aValue <> FDrawAmpScale) then
   begin
      FDrawAmpScale := aValue;
      AdjustBounds;
      Refresh;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetDrawGrid(aValue: Boolean);
begin
   if (aValue <> FDrawGrid) then
   begin
      FDrawGrid := aValue;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.CMColorChanged(var Message: TMessage);
begin
   DrawInactiveSpots;
   inherited;
end;

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetColors(Index: Integer; Value: TColor);
begin
   case Index of
        0: if FBar1Color = Value then exit else FBar1Color := Value;
        1: if FBar2Color = Value then exit else FBar2Color := Value;
        2: if FBar3Color = Value then exit else FBar3Color := Value;
        3: if FInact1Color = Value then exit else FInact1Color := Value;
        4: if FInact2Color = Value then exit else FInact2Color := Value;
        5: if FInact3Color = Value then exit else FInact3Color := Value;
        6: if FScaleTextColor = Value then exit else FScaleTextColor := Value;
        7: if FScaleLineColor = Value then exit else FScaleLineColor := Value;
        8: if FGridColor = Value then exit else FGridColor := Value;
        9: if FScaleBackColor = Value then exit else FScaleBackColor := Value;
   end;
   DrawInactiveSpots;
   Invalidate;
end;

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetPoints(Index, aValue: integer);
begin
   if (aValue>=1) and (aValue<=100) then
   begin
      case Index of
         0: if FPoint1 = aValue then exit else FPoint1 := aValue;
         1: if FPoint2 = aValue then exit else FPoint2 := aValue;
      end;
      CalcNumSpots;
      Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetSpace(aValue: integer);
begin
   if (aValue <> FSpace) AND (aValue >= 0) AND (aValue <= 5) then
   begin
      FSpace := aValue;
      ResetPeakValues;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetSpotSpace(aValue: integer);
begin
   if (aValue <> FSpotSpace) AND (aValue >= 0) AND (aValue <= 10) then
   begin
      FSpotSpace := aValue;
      CalcNumSpots;
      ResetPeakValues;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
Procedure TMMSpectrum.SetSpotHeight(aValue: integer);
begin
   if (aValue <> FSpotHeight) and (aValue > 0) and (aValue <= FHeight div 3) then
   begin
      FSpotHeight := aValue;
      CalcNumSpots;
      ResetPeakValues;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetDrawInactive(aValue: Boolean);
begin
   if (aValue <> FDrawInactive) then
   begin
      FDrawInactive := aValue;
      Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetInactiveDoted(aValue: Boolean);
begin
   if (aValue <> FInactiveDoted) then
   begin
      FInactiveDoted := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetActiveDoted(aValue: Boolean);
begin
   if (aValue <> FActiveDoted) then
   begin
      FActiveDoted := aValue;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetPeakDelay(aValue: integer);
begin
   if (aValue <> FPeakDelay) AND (aValue >= 0) AND (aValue <= 50) then
   begin
      FPeakDelay := aValue;
      ResetPeakValues;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetPeakSpeed(aValue: integer);
begin
   if (aValue <> FPeakSpeed) AND (aValue >= 0) AND (aValue <= 50) then
   begin
      FPeakSpeed := aValue;
      ResetPeakValues;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetNumPeaks(aValue: integer);
begin
   if (aValue <> FNumPeaks) AND (aValue >= 0) AND (aValue <= 5) then
   begin
      FNumPeaks := aValue;
      ResetPeakValues;
      if (FNumPeaks = 0) then
         MMTimeSuspendEvent(FTimerID)
      else if FEnabled then
         MMTimeResumeEvent(FTimerID);
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrum ---------------------------------------------------------}
procedure TMMSpectrum.SetDisplayPeak(aValue: Boolean);
begin
   if (aValue <> FDisplayPeak) then
   begin
      FDisplayPeak := aValue;
      Invalidate;
   end;
end;

{-- TMMSpectrum ---------------------------------------------------------}
function TMMSpectrum.GetPeak: TPeak;
var
   re,im: Float;

begin
   with FPeak do
   begin
      if (FDecayMode <> dmNone) then
      begin
         re := FDisplayVal^[index]/16.0;