Delphi控件源码

开发平台：
Delphi

MMFlange.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMFlange;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Controls,
    IniFiles,
    MMSystem,
    MMRegs,
    MMObj,
    MMDSPObj,
    MMUtils,
    MMMath,
    MMWaveIO,
    MMPCMSup,
    MMFX;
type
   EMMFlangeError = class(Exception);
   {-- TMMFlanger -------------------------------------------------------------}
   TMMFlanger = class(TMMDSPComponent)
   private
      FEnabled       : Boolean;
      FOpen          : Boolean;
      FPFlange       : PFlanger;
      FDescription   : String;
      FDryMix        : TMMEffectVolume;
      FWetMix        : TMMEffectVolume;
      FFeedBack      : TMMFeedBack;
      FMaxDelay      : integer;
      FDelay         : integer;
      FDepth         : Float;
      FRate          : Float;
      FCleanup       : Longint;
      FOnChange      : TNotifyEvent;
      FOnPcmOverflow : TNotifyEvent;
      procedure SetDescription(aValue: String);
      procedure SetEnabled(aValue: Boolean);
      procedure SetGains(index: integer; aValue: TMMEffectVolume);
      procedure SetFeedBack(aValue: TMMFeedBack);
      procedure SetDelays(index: integer; aValue: integer);
      procedure SetDepth(aValue: Float);
      procedure SetRate(aValue: Float);
   protected
      procedure Assign(Source: TPersistent); override;
      procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
      procedure Change; dynamic;
      procedure Update; virtual;
      procedure Opened; override;
      procedure Closed; override;
      procedure Started; override;
      procedure PcmOverflow; dynamic;
      procedure BufferReady(lpwh: PWaveHdr); override;
      procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
   public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;
      procedure SaveToIniFile(IniFile: TFileName; Section: string);
      procedure ReadFromIniFile(IniFile: TFileName; Section: string);
      procedure ReadIniSections(IniFile: TFileName; Strings: TStrings);
      procedure DeleteSection(IniFile: TFileName; Section: string);
      procedure Open;
      procedure Close;
      procedure Process(Buffer: PChar; Length: integer);
      function  CleanUp(Buffer: PChar; Length: integer): Longint;
   published
      property OnChange: TNotifyEvent read FOnChange write FOnChange;
      property OnPcmOverflow: TNotifyEvent read FOnPcmOverflow write FOnPcmOverflow;
      property Input;
      property Output;
      property Enabled: Boolean read FEnabled write SetEnabled default True;
      property Description: String read FDescription write SetDescription;
      property DryMix: TMMEffectVolume index 0 read FDryMix write SetGains;
      property WetMix: TMMEffectVolume index 1 read FWetMix write SetGains;
      property FeedBack: TMMFeedBack read FFeedback write SetFeedBack;
      property MaxDelay: integer index 0 read FMaxDelay write SetDelays;
      property Delay: integer index 1 read FDelay write SetDelays;
      property Depth: Float read FDepth write SetDepth;
      property Rate: Float read FRate write SetRate;
   end;
implementation
{== TMMFlanger ============================================================}
constructor TMMFlanger.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);
   FEnabled     := True;
   FOpen        := False;
   FPFlange     := nil;
   FDescription := 'Untitled';
   FDryMix      := 50;
   FWetMix      := 50;
   FFeedBack    := 0;
   FMaxDelay    := 250;
   FDelay       := 1;
   FDepth       := 0;
   FRate        := 0;
end;
{-- TMMFlanger ------------------------------------------------------------}
destructor TMMFlanger.Destroy;
begin
   Close;
   inherited Destroy;
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Assign(Source: TPersistent);
begin
   if (Source is TMMFlanger) then
   begin
      if (Source <> nil) then
      begin
         Enabled    := TMMFlanger(Source).Enabled;
         Description:= TMMFlanger(Source).Description;
         DryMix     := TMMFlanger(Source).DryMix;
         WetMix     := TMMFlanger(Source).WetMix;
         FeedBack   := TMMFlanger(Source).FeedBack;
         MaxDelay   := TMMFlanger(Source).MaxDelay;
         Delay      := TMMFlanger(Source).Delay;
         Depth      := TMMFlanger(Source).Depth;
         Rate       := TMMFlanger(Source).Rate;
      end;
   end;
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.PcmOverflow;
begin
   if assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.Change;
begin
   if assigned(FOnChange) then FOnChange(Self);
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.SaveToIniFile(IniFile: TFileName; Section: string);
begin
   if (IniFile <> '') then
   begin
      with TIniFile.Create(IniFile) do
      try
         if Pos('Flanger.',Section) = 0 then Section := 'Flanger.'+Section;
         WriteInteger(Section, 'DryMix', DryMix);
         WriteInteger(Section, 'WetMix', WetMix);
         WriteInteger(Section, 'FeedBack', FeedBack);
         WriteInteger(Section, 'MaxDelay', MaxDelay);
         WriteInteger(Section, 'Delay', Delay);
         WriteString(Section, 'Depth', FloatToStr(Depth));
         WriteString(Section, 'Rate', FloatToStr(Rate));
      finally
         Free;
      end;
   end;
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.ReadFromIniFile(IniFile: TFileName; Section: string);
var
   i,P: integer;
begin
   if (IniFile <> '') then
   begin
      with TIniFile.Create(IniFile) do
      try
         if Pos('Flanger.',Section) = 0 then Section := 'Flanger.'+Section;
         i := ReadInteger(Section, 'MaxDelay', -1);
         if (i > 0) then
         begin
            DryMix      := ReadInteger(Section, 'DryMix', 50);
            WetMix      := ReadInteger(Section, 'WetMix', 50);
            FeedBack    := ReadInteger(Section, 'FeedBack', 0);
            MaxDelay    := ReadInteger(Section, 'MaxDelay', 250);
            Delay       := ReadInteger(Section, 'Delay', 1);
            Depth       := StrToFloat(ReadString(Section, 'Depth', '4.0'));
            Rate        := StrToFloat(ReadString(Section, 'Rate', '1.0'));
            P := Pos('.',Section);
            if (P <> 0) then Section := Copy(Section,P+1,MaxInt);
            Description := Section;
         end;
      finally
         Free;
      end;
   end;
end;
{-- TMMFlanger ------------------------------------------------------------}
procedure TMMFlanger.ReadIniSections(IniFile: TFileName; Strings: TStrings);
var
   i, P: integer;
   Sections: TStringList;
begin
   if (IniFile <> '') and (Strings <> nil) then
   begin
      with TIniFile.Create(IniFile) do
      try
         Sections := TStringList.Create;
         try
            ReadSections(Sections);
            Strings.BeginUpdate;
            try
               Strings.Clear;
               for i := 0 to Sections.Count-1 do
               begin
                  P := Pos('.',Sections[i]);
                  if (P <> 0) then Strings.Add(Copy(Sections[i],P+1,MaxInt));
               end;
            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.

						