mmflange.pas

一套及时通讯的原码

            finally
               Strings.EndUpdate;
            end;

         finally
            Sections.Free;
         end;

      finally
         Free;
      end;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.DeleteSection(IniFile: TFileName; Section: string);
begin
   if (IniFile <> '') then
   begin
      with TIniFile.Create(IniFile) do
      try
         if Pos('Flanger.',Section) = 0 then Section := 'Flanger.'+Section;
         EraseSection(Section);

      finally
         Free;
      end;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      if FEnabled then Update;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetDescription(aValue: String);
begin
   if (aValue <> FDescription) then
   begin
      FDescription := aValue;
      Change;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetGains(index: integer; aValue: TMMEffectVolume);
begin
   case index of
       0: if (aValue = FDryMix) then exit
          else
          begin
             FDryMix := aValue;
             if FOpen then FPFlange^.DryMix := MulDiv(aValue,256,100);
             Change;
          end;
       1: if (aValue = FWetMix) then exit
          else
          begin
             FWetMix := aValue;
             if FOpen then FPFlange^.Wetmix := MulDiv(aValue,256,100);
             Change;
          end;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetFeedBack(aValue: TMMFeedBack);
begin
   if (aValue <> FFeedBack) then
   begin
      FFeedBack := aValue;
      if FOpen then FPFlange^.FeedBack := MulDiv(aValue,256,100);
      Change;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetDelays(index: integer; aValue: integer);
begin
   case index of
      0: if (aValue = FMaxDelay) then exit else
         begin
            FMaxDelay := Max(aValue,1);
         end;
      1: if (aValue = FDelay) then exit else
         begin
            FDelay := MinMax(aValue,1,FMaxDelay);
            Update;
            Change;
         end;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetDepth(aValue: Float);
begin
   if (aValue <> FDepth) then
   begin
      FDepth := MaxR(aValue,0.0);
      Update;
      Change;
   end;
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SetRate(aValue: Float);
begin
   if (aValue <> FRate) then
   begin
      FRate := MaxR(aValue,0.0);
      Update;
      Change;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Update;
begin
   { setup the phaser with the params }
   if FOpen then
   begin
      FCleanup := 0;
      if (FDelay > FCleanUp) then FCleanUp := FDelay;

      if (FCleanup > 0) then
      begin
         { convert cleanup time to bytes }
         FCleanup := wioTimeToSamples(PWaveFormat,FCleanup);
      end;
      SetFlanger(FPFlange, FDryMix, FWetMix, FFeedBack, FDelay, FDepth, FRate);
   end;
end;

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

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Open;
begin
   if not FOpen then
   begin
      if pcmIsValidFormat(PWaveFormat) then
      begin
         FPFlange := InitFlanger(PWaveFormat,FMaxDelay);
         if (FPFlange = nil) then OutOfMemoryError
         else
         begin
            FOpen := True;
            Update;
         end;
      end;
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Close;
begin
   if FOpen then
   begin
      FOpen := False;
      DoneFlanger(FPFlange);
   end;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Process(Buffer: PChar; Length: integer);
begin
   { process the buffer }
   if (FPFlange <> nil) then
      if DoFlanger(FPFlange, Buffer, Length) then
         GlobalSynchronize(PcmOverflow);
end;

{-- TMMFlanger ------------------------------------------------------------}
function TMMFlanger.CleanUp(Buffer: PChar; Length: integer): Longint;
begin
   { process the remaining delayed bytes in the delay lines }
   if (FPFlange <> nil) and (FCleanup > 0) then
   begin
      FCleanup := Max(FCleanup - Length,0);
      FillChar(Buffer^, Length, 0);
      if DoFlanger(FPFlange, Buffer, Length) then
         GlobalSynchronize(PcmOverflow);
   end;
   { return the remaining bytes to process }
   Result := FCleanup;
end;

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

   inherited Opened;
end;

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

   inherited Closed;
end;

{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Started;
begin
   Update;

   inherited Started;
end;

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

   inherited BufferReady(lpwh);
end;

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

   if Enabled and FOpen then
   begin
      if not MoreBuffers then
      begin
         aLength := lpwh^.dwBufferLength;
         if Cleanup(lpwh^.lpData, aLength) > 0 then MoreBuffers := True;
         lpwh^.dwBytesRecorded := aLength;
      end
      else Process(lpwh^.lpData, lpwh^.dwBytesRecorded);
   end;
end;

end.