mmspgram.pas

一套及时通讯的原码

   {$ENDIF}
end;

{-- TMMSpectrogram ------------------------------------------------------}
Procedure TMMSpectrogram.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
      SetBytesPerSpectrogram;
      Invalidate;
   end;
end;

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

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetGain(aValue: TMMSpectrogramGain);
begin
   if (aValue <> FGain) then
   begin
      FGain := aValue;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.Select(sStart, sEnd: Longint; Redraw: Boolean);
var
   oldStart,oldEnd: Longint;
begin
   oldStart:= FSelectStart;
   oldEnd := FSElectEnd;

   if (sStart <> FSelectStart) then
   begin
      if (sStart < 0) then sStart := -1;
      if (sStart > FWidth) then sStart := FWidth;
      FSelectStart := sStart;
   end;

   if (sEnd <> FSelectEnd) then
   begin
      if (sEnd < 0) then sEnd := -1;
      if (sEnd > FWidth) then sEnd := FWidth;
      FSelectEnd := sEnd;
   end;

   if (FSelectStart > FSelectEnd) then
   begin
      SwapLong(FSelectStart,FSelectEnd);
   end;

   if (FSelectEnd - FSelectStart <= 0) then
   begin
      FSelectStart := -1;
      FSelectEnd := -1;
   end;

   if Redraw and ((oldStart <> FSelectStart) or (oldEnd <> FSelectEnd)) then
      Refresh;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetLocator(aValue: Longint);
var
   oldLoc: Longint;
begin
   oldLoc := FLocator;

   if (aValue <> FLocator) then
   begin
      if (aValue < 0) then aValue := -1;
      if (aValue > FWidth) then aValue := FWidth;
      FLocator := aValue;
   end;

   if (oldLoc <> FLocator) then
      Refresh;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetAmplitudeScale;
begin
   { Change the amplitude scale factor }
   aValue := MinMax(aValue, 0, 1000);
   if (aValue <> GetAmplitudeScale) then
   begin
      FAmpScale := 0.01*aValue;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
function TMMSpectrogram.GetAmplitudeScale: integer;
begin
   Result := Round(FAmpScale/0.01);
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetFreqScale(aValue: integer);
begin
   aValue := MinMax(aValue,1,16);
   if (aValue <> Trunc(FFreqScaleFactor)) then
   begin
      FFreqScaleFactor := aValue;
      { Re-initialize the display }
      SetupYScale;
      { calc the number of scale steps }
      CalcScaleSteps;
      Invalidate;
   end;
end;

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

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetFreqBase(aValue: integer);
begin
   aValue := Max(aValue,0);

   if (aValue <> Trunc(FFreqBase)) then
   begin
      FFreqBase := aValue;
      { Re-initialize the display }
      SetupYScale;
      { calc the number of scale steps }
      CalcScaleSteps;
      Invalidate;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
function TMMSpectrogram.GetFreqBase: integer;
begin
   Result := Trunc(FFreqBase);
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetSensitivy(aValue: integer);
begin
   aValue := MinMax(aValue, -90, -9);
   if (aValue <> FSensitivy) then
   begin
      FSensitivy := aValue;
   end;
end;

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

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetAccelerate(aValue: Boolean);
begin
   if (aValue <> FAccelerate) then
   begin
      FAccelerate := aValue;
      if not FAccelerate and FScroll then Invalidate;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetEmbossed(aValue: Boolean);
begin
   if (aValue <> FEmbossed) then
   begin
      FEmbossed := aValue;
      Invalidate;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
Procedure TMMSpectrogram.SetScroll(aValue: Boolean);
begin
   if (aValue <> FScroll) then
   begin
      FScroll := aValue;
      Invalidate;
   end;
end;

{-- TMMSpectrogram ------------------------------------------------------}
Procedure TMMSpectrogram.SetColors(Index: Integer; Value: TColor);
begin
   case Index of
        0: if FScaleTextColor = Value then exit else FScaleTextColor := Value;
        1: if FScaleLineColor = Value then exit else FScaleLineColor := Value;
        2: if FBarColor = Value then exit else FBarColor := Value;
        3: if FBarTickColor = Value then exit else FBarTickColor := Value;
        4: if FScaleBackColor = Value then exit else FScaleBackColor := Value;
        5: if FSelectColor = Value then exit else FSelectColor := Value;
        6: if FSelectDotColor = Value then exit else FSelectDotColor := Value;
        7: if FLocatorColor = Value then exit else FLocatorColor := Value;
   end;
   Invalidate;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetPalette(LogPal: PLogPalette);
begin
   Refresh;
   DIBCanvas.SetLogPalette(LogPal);
   Invalidate;
end;

{-- TMMSpectrogram ------------------------------------------------------}
procedure TMMSpectrogram.SetPalMode(aValue: TMMSpectrogramPalette);
type
   { Logical Palette }
   TLogPal = packed record
    palVersion: Word;
    palNumEntries: Word;
    palEntry: array[0..255] of TPaletteEntry;
  end;

var
   i,clr: Longint;
   LogPal: TLogPal;

begin
   FPalMode := aValue;

   if not (csLoading in ComponentState) and
      not (csReading in ComponentState) then
   begin
      FillChar(LogPal, sizeOf(LogPal),0);
      with LogPal do
      begin
         palVersion := $300;
         palNumEntries := 256;

         for i := MIN_COLOR to MIN_COLOR+NUM_COLORS-1 do
         begin
            clr := (i-MIN_COLOR)*256 div NUM_COLORS;
            case FPalMode of
              spHSV:
              begin
                 if (clr < 64) then
                 begin
                    palEntry[i].peRed := 0;
                    palEntry[i].peGreen := clr*4;
                    palEntry[i].peBlue := 255;
                 end
                 else if (clr < 128) then
                 begin
                    palEntry[i].peRed := 0;
                    palEntry[i].peGreen := 255;
                    palEntry[i].peBlue := 510-clr*4;
                 end
                 else if (clr < 192) then
                 begin
                    palEntry[i].peRed := clr*4-510;
                    palEntry[i].peGreen := 255;
                    palEntry[i].peBlue := 0;
                 end
                 else
                 begin
                    palEntry[i].peRed := 255;
                    palEntry[i].peGreen := 1020-clr*4;
                    palEntry[i].peBlue := 0;
                 end;
              end;
              spThreshold:
              begin
                 if (clr < 16) then
                 begin
                    palEntry[i].peRed := 0;
                    palEntry[i].peGreen := 0;
                    palEntry[i].peBlue := 0;
                 end
                 else if (clr < 64) then
                 begin
                    palEntry[i].peRed := 0;
                    palEntry[i].peGreen := clr*4;
                    palEntry[i].peBlue := 255;
                 end
                 else if (clr < 128) then
                 begin
                    palEntry[i].peRed := 0;
                    palEntry[i].peGreen := 255;
                    palEntry[i].peBlue := 510-clr*4;
                 end
                 else if (clr < 192) then
                 begin
                    palEntry[i].peRed := clr*4-510;
                    palEntry[i].peGreen := 255;
                    palEntry[i].peBlue := 0;
                 end
                 else
                 begin
                    palEntry[i].peRed := 255;
                    palEntry[i].peGreen := 1020-clr*4;
                    palEntry[i].peBlue := 0;
                 end;
              end;
              spCool:
              begin
                 palEntry[i].peRed := clr;
                 palEntry[i].peGreen := 255-clr;
                 palEntry[i].peBlue := 255;
              end;
              spHot:
              begin
                 if (clr < 96) then
                 begin
                    palEntry[i].peRed := Trunc(clr*2.66667+0.5);
                    palEntry[i].peGreen := 0;
                    palEntry[i].peBlue := 0;
                 end
                 else if (clr < 192) then
                 begin
                    palEntry[i].peRed := 255;
                    palEntry[i].peGreen := Trunc(clr*2.66667-254);
                    palEntry[i].peBlue := 0;
                 end
                 else
                 begin
                    palEntry[i].peRed := 255;
                    palEntry[i].peGreen := 255;
                    palEntry[i].peBlue := Trunc(clr*4.0-766.0);
                 end;
              end;
              spBone:
              begin
                 if (clr < 96) then
                 begin
                    palEntry[i].peRed := Trunc(clr*0.88889);
                    palEntry[i].peGreen := Trunc(clr*0.88889);
                    palEntry[i].peBlue := Trunc(clr*1.20000);
                 end
                 else if (clr < 192) then
                 begin
                    palEntry[i].peRed := Trunc(clr*0.88889);
                    palEntry[i].peGreen := Trunc(clr*1.20000-29);
                    palEntry[i].peBlue := Trunc(clr*0.88889+29);
                 end
                 else
                 begin
                    palEntry[i].peRed := Trunc(clr*1.20000-60);
                    palEntry[i].peGreen := Trunc(clr*0.88889+29);
                    palEntry[i].peBlue := Trunc(clr*0.88889+29);
                 end;
              end;
              spCopper:
              begin
                 if (clr < 208) then
                 begin
                    palEntry[i].peRed := Trunc(clr*1.23);
                    palEntry[i].peGreen := Trunc(clr*0.78);
                    palEntry[i].peBlue := Trunc(clr*0.5);
                 end
                 else
                 begin
                    palEntry[i].peRed := 255;
                    palEntry[i].peGreen := Trunc(clr*0.78);
                    palEntry[i].peBlue := Trunc(clr*0.5);
                 end;