mmmeter.pas

一套及时通讯的原码

begin
   inherited ChangeDesigning(aValue);

   if not (csDesigning in ComponentState) then
   begin
      { create the peak timer }
      if FTimerID = 0 then
         FTimerID := MMTimeSetEvent(25, False, TimeCallBack, Longint(Self));
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetBackGround(aValue: TBitmap);
begin
   FBackBitmap.Assign(aValue);
   Invalidate;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.GainOverflow;
begin
   if Assigned(FOnGainOverflow) then FOnGainOverflow(Self);
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.PcmOverflow;
begin
   if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.ResetDecayBuffers;
var
   i: integer;

begin
   FDecayPtr := 0;
   FDecayCntAct := 0;      { Restart the count of number of samples taken }
   FLastVal := 0;
   FLastVal_F := 0;
   for i := 0 to MAXDECAYCOUNT-1 do FDataBuf[i] := 0;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.ResetData;
begin
   FPeakValue := 0;
   FPeak := 0;
   FPeakCounter := 0;
   FData := 0;
   ResetDecayBuffers;
   Refresh;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetDecayMode(aValue: TMMDecayMode);
begin
   { Select averaging mode }
   if (aValue <> FDecayMode) then
   begin
      FDecayMode := aValue;
      { Re-initialize the buffers }
      ResetDecayBuffers;
   end;
end;

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

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetShowPeak(aValue: Boolean);
begin
   if (aValue <> FShowPeak) then
   begin
      FShowPeak := aValue;
      FPeakCounter := 0;
      if FShowPeak then
         MMTimeResumeEvent(FTimerID)
      else
         MMTimeSuspendEvent(FTimerID);
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetPeakDelay(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 50);
   if (aValue <> FPeakDelay) then
   begin
      FPeakDelay := aValue;
      FPeakCounter := 0;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetPeakSpeed(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 50);
   if (aValue <> FPeakSpeed) then
   begin
      FPeakSpeed := aValue;
      FPeakCounter := 0;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.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
         ResetData;
         MMTimeResumeEvent(FTimerID);
      end;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
   inherited SetBounds(aLeft, aTop, aWidth, aHeight);
   Changed;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.Changed;
begin
   FClientRect := BeveledRect;
   FWidth  := FClientRect.Right - FClientRect.Left;
   FHeight := FClientRect.Bottom - FClientRect.Top;

   FSaveBitmap.Width := Max(FWidth,0);
   FSaveBitmap.Height := Max(FHeight,0);
   FOffBitmap.Width := Max(FWidth,0);
   FOffBitmap.Height := Max(FHeight,0);

   ResetData;

   inherited Changed;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetBytesPerMeter;
begin
   FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FSamples;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetSamples(aValue: integer);
begin
   aValue := Max(aValue, 1);
   if (aValue <> FSamples) then
   begin
      FSamples := aValue;
      SetBytesPerMeter;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

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

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

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

{-- TMMCustomMeter ------------------------------------------------------}
function TMMCustomMeter.GetPCMWaveFormat: TPCMWaveFormat;
var
   wfx: TWaveFormatEx;

begin
   pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, 11025);
   Result := PPCMWaveFormat(@wfx)^;
end;

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

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

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

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetGain(aValue: Integer);
begin
   if (aValue <> FGain-8) AND (aValue >= -8) AND (aValue <= 32) then
   begin
      FGain := aValue + 8;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Function TMMCustomMeter.GetGain: Integer;
begin
   Result := FGain - 8;
end;

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

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetColors(Index:Integer; aValue: TColor);
begin
   case Index of
      0: if FScale1Color = aValue then exit else FScale1Color := aValue;
      1: if FScale2Color = aValue then exit else FScale2Color := aValue;
      2: if FScale3Color = aValue then exit else FScale3Color := aValue;
      3: if FNeedleColor = aValue then exit else FNeedleColor := aValue;
      4: if FPeakColor = aValue then exit else FPeakColor := aValue;
   end;
   Invalidate;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetNeedleOffset(aValue: integer);
begin
   if (aValue <> FNeedleOffset) then
   begin
      FNeedleOffset := Max(aValue,0);
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetNeedleWidth(aValue: integer);
begin
   if (aValue <> FNeedleWidth) then
   begin
      FNeedleWidth := Max(aValue,0);
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetScaleOrigin(aValue: TMMScaleOrigin);
begin
   if (aValue <> FScaleOrigin) then
   begin
      FScaleOrigin := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetScaleHeight(Index: integer; aValue: integer);
begin
   aValue := Max(aValue,0);
   case Index of
      0: if FScaleHeight1 = aValue then exit else FScaleHeight1 := aValue;
      1: if FScaleHeight2 = aValue then exit else FScaleHeight2 := aValue;
   end;
   Invalidate;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetScaleTicks(aValue: integer);
begin
   if (aValue <> FScaleTicks) then
   begin
      FScaleTicks := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetLargeTicks(aValue: integer);
begin
   if (aValue <> FLargeTicks) then
   begin
      FLargeTicks := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetTextTicks(aValue: integer);
begin
   if (aValue <> FTextTicks) then
   begin
      FTextTicks := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetScaleAngle(aValue: integer);
begin
   if (aValue <> FScaleAngle) then
   begin
      FScaleAngle := MinMax(aValue, 45, 180);
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetDrawScale(aValue: Boolean);
begin
   if (aValue <> FDrawScale) then
   begin
      FDrawScale := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.SetTopSpace(aValue: integer);
begin
   if (aValue <> FTopSpace) then
   begin
      FTopSpace := aValue;
      Invalidate;
   end;
end;

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

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetLogAmp(aValue: Boolean);
begin
   if (aValue <> FLogAmp) then
   begin
      FLogAmp := aValue;
      Invalidate;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetDCOffset(Index,aValue: Integer);
begin
   case Index of
      0: if FDCOffsetL = aValue then exit else FDCOffsetL := -aValue;
      1: if FDCOffsetR = aValue then exit else FDCOffsetR := -aValue;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}