mmlevel.pas

一套及时通讯的原码

   FSpotWidth := Max(FSpotWidth,1);
   if (FKind = lkHorizontal) then
   begin
      FNumSpots := (FWidth+FSpotSpace) div (FSpotWidth+FSpotSpace);
      FNumSpots := Max(FNumSpots,1);          { fix div by zerro !!! }
      FFirstSpace := (FWidth-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
   end
   else
   begin
      FNumSpots := (FHeight+FSpotSpace)div(FSpotWidth+FSpotSpace);
      FNumSpots := Max(FNumSpots,1);           { fix div by zerro !!! }
      FFirstSpace := (FHeight-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
   end;

   { calc the spot on which the next color starts }
   FPoint1Spot := (FPoint1 * FNumSpots) div 100;
   FPoint2Spot := (FPoint2 * FNumSpots) div 100;

   { redraw background }
   DrawInactiveSpots;

   { we will see anything in designer }
   if (csDesigning in ComponentState) and FEnabled then
   begin
      if (FPoint2Spot < FNumSpots) then
         FData := FPoint2Spot + ((FNumSpots-FPoint2Spot) div 2)
      else if (FPoint1Spot < FNumSpots) then
         FData := FPoint1Spot + ((FNumSpots-FPoint1Spot) div 2)
      else
         FData := FNumSpots - (FNumSpots div 4);
   end
   else
   begin
      FPeak := 0;
      FData := 0;
   end;
end;

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

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

   DrawInactiveSpots;
   Invalidate;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.Changed;
begin
   FClientRect := BeveledRect;
   FWidth  := Max(FClientRect.Right - FClientRect.Left,1);
   FHeight := Max(FClientRect.Bottom - FClientRect.Top,1);

   DIBCanvas.SetBounds(0,0,FWidth,FHeight);
   FBarDIB.SetBounds(0,0,FWidth,FHeight);

   { recalculate the number of spots }
   CalcNumSpots;

   inherited Changed;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetBytesPerLevel;
begin
   FBytes := (Ord(FBits)+1) * (Ord(FMode)+1) * FSamples;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetSamples(aValue: integer);
begin
   aValue := Max(aValue, 1);
   if (aValue <> FSamples) then
   begin
      FSamples := aValue;
      SetBytesPerLevel;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetPCMWaveFormat(wf: TPCMWaveFormat);
var
   pwfx: PWaveFormatEx;

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

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

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

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      SetBytesPerLevel;
      Invalidate;
   end;
end;

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

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) then
   begin
      FMode := aValue;
      SetBytesPerLevel;
      Invalidate;
   end;
end;

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

{-- TMMCustomLevel ------------------------------------------------------}
function TMMCustomLevel.GetGain: Integer;
begin
   Result := FGain - 8;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.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;
   CalcNumSpots;
   Invalidate;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetColors(Index:Integer; aValue: TColor);
begin
   case Index of
      0: if FBar1Color = aValue then exit else FBar1Color := aValue;
      1: if FBar2Color = aValue then exit else FBar2Color := aValue;
      2: if FBar3Color = aValue then exit else FBar3Color := aValue;
      3: if FInact1Color = aValue then exit else FInact1Color := aValue;
      4: if FInact2Color = aValue then exit else FInact2Color := aValue;
      5: if FInact3Color = aValue then exit else FInact3Color := aValue;
   end;
   DrawInactiveSpots;
   Invalidate;
end;

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

{-- TMMCustomLevel ------------------------------------------------------}
function TMMCustomLevel.GetDCOffset(Index: Integer): integer;
begin
   case Index of
      0: Result := -FDCOffsetL;
      1: Result := -FDCOffsetR;
      else Result := 0;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetInactiveDoted(aValue: Boolean);
begin
   if (aValue <> FInactiveDoted) then
   begin
      FInactiveDoted := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetActiveDoted(aValue: Boolean);
begin
   if (aValue <> FActiveDoted) then
   begin
      FActiveDoted := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

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

{-- TMMCustomLevel ------------------------------------------------------}
Procedure TMMCustomLevel.RefreshPCMData(PCMData: Pointer);
Var
   i: integer;
   ReIndex: integer;
   BestValue,Value,DCOffs: integer;

begin
   if FEnabled and Visible then
   begin
      BestValue := 0;
      ReIndex := Ord(FChannel)-1;

      if (FBits = b8bit) then
         if (FMode = mMono) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS((PByteArray(PCMData)^[i]+FDCOffsetL-128) shl 8);
            if (Value > BestValue) then BestValue := Value;
         end
         else if (FChannel = chBoth) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS(((Word(PByteArray(PCMData)^[i+i]+FDCOffsetL)+PByteArray(PCMData)^[i+i+1]+FDCOffsetR)div 2-128) shl 8);
            if (Value > BestValue) then BestValue := Value;
         end
         else
         begin
            if (FChannel = chLeft) then
                DCOffs := FDCOffsetL
            else
                DCOffs := FDCOffsetR;

            for i := 0 to FSamples-1 do
            begin
               Value := ABS((PByteArray(PCMData)^[i+i+ReIndex]+DCOffs-128) shl 8);
               if (Value > BestValue) then BestValue := Value;
            end;
         end
      else
         if (FMode = mMono) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS(PSmallArray(PCMData)^[i]+FDCOffsetL);
            if (Value > BestValue) then BestValue := Value;
         end
         else if (FChannel = chBoth) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS((Long(PSmallArray(PCMData)^[i+i]+FDCOffsetL)+PSmallArray(PCMData)^[i+i+1]+FDCOffsetR)div 2);
            if (Value > BestValue) then BestValue := Value;
         end
         else
         begin
            if (FChannel = chLeft) then
                DCOffs := FDCOffsetL
            else
                DCOffs := FDCOffsetR;

            for i := 0 to FSamples-1 do
            begin
               Value := ABS(PSmallArray(PCMData)^[i+i+ReIndex]+DCOffs);
               if (Value > BestValue) then BestValue := Value;
            end;
         end;

      if (BestValue >= FRange) then PcmOverflow;

      SetData(BestValue);
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetData(SampleValue: integer);
var
   dbValue: Float;

begin
   SampleValue := abs(SampleValue);

   FCurPeak := SampleValue;

   if (SampleValue = 0) and (FData = 0) and not FRefresh then exit;

   if (FDecayMode <> dmNone) then
   begin
      inc(FDecayPtr);
      inc(FDecayCntAct);
      if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;
      if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;

      { In decay mode, need to average the value }
      case Ord(FDecayMode) of
        1: begin
              FLastVal_F := FLastVal_F*FDecayFactor;
              if (SampleValue > FLastVal_F) then FLastVal_F := SampleValue
              else SampleValue := Trunc(FLastVal_F);
           end;
        2: begin
	      FLastVal_F := FLastVal_F*FDecayFactor+(1-FDecayFactor)*SampleValue;
	      SampleValue := Floor(FLastVal_F);
           end;
        3: begin
              FLastVal := FLastVal+(SampleValue-FDataBuf[FDecayPtr]);
              FDataBuf[FDecayPtr] := SampleValue;
              SampleValue := FLastVal div FDecayCntAct;
           end;
      end;
   end;

   if FLogAmp then
   begin
      { add the gain and calc the actual db value }
      dbValue := Log10(MaxR(MulDiv32(SampleValue,FGain,8)/FRange,0.000001))*20;

      { now the scaling }
      SampleValue := Max(Round((dbValue-FSensitivy)*FNumSpots/-FSensitivy),0);
   end
   else
   begin
      { calc the low limit (Sensivity(db) to sample value }
      dbValue := FRange/pow(10,-FSensitivy/20);
      { now the scaling }
      SampleValue := Max(Round((MulDiv32(SampleValue,FGain,8)-dbValue)*FNumSpots/(FRange-dbValue)),0);
   end;

   if (Direction = dirSymetric) then
       SampleValue := SampleValue div 2;

   if FDrawReversed then
      SampleValue := FNumSpots-SampleValue;

   if (SampleValue > FNumSpots) then
   begin
      GainOverflow;
      SampleValue := FNumSpots;
   end;

   if (SampleValue >= FPeak) and (SampleValue > 0) and (FNumPeaks > 0) then
   begin
      FRefresh := True;
      FPeak := SampleValue;                          {start a new peak timer }
      FPeakCounter := (FPeakDelay*2)+1;
   end;

   if (SampleValue <> FData) or FRefresh then
   begin