mmpeak.pas

一套及时通讯的原码

   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMPeakError.Create(LoadResStr(IDS_INVALIDFORMAT));

      if (PWaveFormat <> nil) and (PWaveFormat^.wBitsPerSample = 8) then
          FSilence := 128
      else
          FSilence := 0;

      ResetData;
   end;

   inherited SetPWaveFormat(aValue);
end;

{-- TMMPeakDetect ------------------------------------------------------------}
function TMMPeakDetect.GetNumPeaks: integer;
begin
   Result := FFTLen div 2;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
function TMMPeakDetect.GetPeaks(index: integer): Longint;
begin
   if index < NumPeaks then
      Result := FPeaks[index]
   else
      Result := 0;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
function TMMPeakDetect.GetPeakIndex(Freq: Float): integer;
begin
   Result := Min(Trunc(Freq/Resolution),NumPeaks);
end;

{-- TMMPeakDetect ------------------------------------------------------------}
function TMMPeakDetect.GetResolution: Float;
begin
   Result := 0;
   if (PWaveFormat <> nil) then
       Result := PWaveFormat^.nSamplesPerSec/FFTLen;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Open;
begin
   if not FOpen then
   begin
      if pcmIsValidFormat(PWaveFormat) then
      begin
         FOpen := True;
      end;
   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Close;
begin
   if FOpen then
   begin
      FOpen := False;
   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Start;
begin
   if FOpen and not FStarted then
   begin
      ResetData;
      FStarted := True;
   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Stop;
begin
   if FStarted then
   begin
      FStarted := False;
   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
function TMMPeakDetect.GetBytesPerFFT: Longint;
begin
   if (PWaveFormat <> nil) then
       Result := PWaveformat^.nBlockAlign * FFTLen
   else
       Result := 0;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Process(Buffer: PChar; Length: integer);
var
   Value,nBytes,nRead,reqBytes: Longint;
   i: Integer;
   ReIndex: integer;
   re,im,a2: Float;
   fTemp: array[0..MAX_FFTLEN-1] of Float;

begin
   if FOpen and FEnabled then
   begin
      FillChar(fTemp, sizeOf(fTemp),0);
      ResetData;

      if FDetectPeaks then
      begin
         pcmFindPeak(PWaveFormat, Buffer, Length, FPeakLeft, FPeakRight);
         FPeakLeft  := abs(FPeakLeft);
         FPeakRight := abs(FPeakRight);
      end
      else
      begin
         FPeakLeft  := 0;
         FPeakRight := 0;
      end;

      nRead := 0;
      reqBytes := GetBytesPerFFT;
      while (Length > 0) do
      begin
         nBytes := Min(Length,reqBytes);
         GlobalMoveMem((Buffer+nRead)^,FData^,nBytes);
         inc(nRead,nBytes);
         dec(Length,nBytes);

         if nBytes < reqBytes then
            GlobalFillMem((PChar(FData)+nBytes)^,reqBytes-nBytes,FSilence);

         ReIndex := Ord(FChannel)-1;
         { perform windowing on sample Data }
         if (PWaveFormat^.wBitsPerSample = 8) then
         begin
            if (PWaveFormat^.nChannels = 1) then
            for i := 0 to FFTLen-1 do
            begin
               Value := PByteArray(FData)^[i];
               fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
            end
            else if (FChannel = chBoth) then
            for i := 0 to FFTLen-1 do
            begin
               Value := (Word(PByteArray(FData)^[i+i])+PByteArray(FData)^[i+i+1])div 2;
               fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
            end
            else for i := 0 to FFTLen-1 do
            begin
               Value := PByteArray(FData)^[i+i+ReIndex];
               fTemp[i] := MulDiv32(Value-128,FWinBuf^[i],128);
            end;
         end
         else
         begin
            if (PWaveFormat^.nChannels = 1) then
            for i := 0 to FFTLen-1 do
            begin
               Value := PSmallArray(FData)^[i];
               fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
            end
            else if (FChannel = chBoth) then
            for i := 0 to FFTLen-1 do
            begin
               Value := (Long(PSmallArray(FData)^[i+i])+PSmallArray(FData)^[i+i+1])div 2;
               fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
            end
            else for i := 0 to FFTLen-1 do
            begin
               Value := PSmallArray(FData)^[i+i+ReIndex];
               fTemp[i] := MulDiv32(Value,FWinBuf^[i],32768);
            end;
         end;

         { calc the FFT }
         DoRealFFT(FpFFT,@fTemp,1);

         { calc the magnitude }
         for i := 0 to (FFTLen div 2)-1 do
         begin
            { Compute the magnitude }
            re := fTemp[i+i]/(FFTLen div 2);
            im := fTemp[i+i+1]/(FFTLen div 2);
            a2 := re*re+im*im;

            { Watch for possible overflow }
            if a2 < 0 then a2 := 0;
            Value := Trunc(sqrt(a2));
            if assigned(FOnPeak) then FOnPeak(Self,i,Value);
            if Value > FPeaks[i] then
               FPeaks[i] := Value;
         end;
      end;
   end;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Opened;
begin
   Open;

   inherited Opened;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Closed;
begin
   Close;

   inherited Closed;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Started;
begin
   Start;

   inherited Started;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.Stopped;
begin
   Stop;

   inherited Stopped;
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.BufferReady(lpwh: PWaveHdr);
begin
   if Enabled and FOpen then
   begin
      Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
   end;

   inherited BufferReady(lpwh);
end;

{-- TMMPeakDetect ------------------------------------------------------------}
procedure TMMPeakDetect.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
begin
   inherited BufferLoad(lpwh, MoreBuffers);

   if Enabled and FOpen then
   begin
      Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
   end;
end;

end.