Delphi控件源码

开发平台：
Delphi

Fxalgo.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 Fxalgo;
interface
const
     BFSZ     = 4096    { main delay buffer }
     MAX_XTAB = 512;    { crossfade lookup table size for pitch change }
type
    // program description struct
    TProgram = record
       Name: String;        // ASCII name of program */
       dry_mix: Double;     // dry (unaffected) signal mix */
       wet_mix: Double;     // wet (affected) signal mix */
       feedback: Double;    // feedback */
       rate    : Double;    // usually rate of sweep */
       depth   : Double;    // width of sweep */
       delay   : Double;    // fixed delay factor (base pitch for phaser) */
    end;
    // handy typedefs
    Tbw = record
        case integer of
           1: b: array [0..1] of Byte;
           2: w: word;
        end;
    end;
    Twl = record
        case integer of
           1: w: array [0..1] of Word;
           2: l: Longint;
        end;
    end;
implementation
// macros for pitch_change delay index manipulation
procedure inc_index(var x: integer);
begin
   x := (x + 1) and (BFSZ - 1);
end;
procedure inc_indexes(var x1,x2: integer);
begin
   x2 := x1;
   inc_index(x1);
end;
(*// table of programs (it's very easy to modify and add programs)
var
   struct program programs[] = {
         /*  Name/vector      Dry     Wet   Feedback Rate    Depth   Delay */
     "Echoes", flange_chorus,  0.999,  0.999,  0.7,    0.0,    0.0,    250.0},
{"Slow flange",flange_chorus,  0.999,  0.999,  0.0,    2.0,    6.0,    0.0},
{ "Slow invert flange w FB",
                flange_chorus,  0.999,  -0.999, -0.7,   2.0,    6.0,    0.0},
{ "Slow chorus",flange_chorus,  0.999,  0.999,  0.0,    11.0,   20.0,   20.0},
{ "Cheesy "take me to your leader" robot voice",
                  flange_chorus,  0.0,    0.999,  0.75,   0.0,    0.0,    12.5},
{ "Crazy pitch bend chorus",
                   flange_chorus,  0.999,  0.999,  0.3,    150.0,  40.0,   40.0},
{ "Darth",pitch_change,            0.0,    0.999,  0.0,    -0.35,  25.0,   0.0},
{ "Major third up", pitch_change,  0.999,  0.999,  0.0,    0.2599, 35.0,   0.0},
{ "Octave up",pitch_change,        0.999,  0.999,  0.0,    1.0,    40.0,   0.0},
{ "Munchkins on helium",pitch_change,0.0,  0.999,  0.4,    0.3348, 35.0,   0.0},
{ "Descending echoes",pitch_change, 0.0,   0.999,  0.5,    -0.2,   35.0,   120.0},
{ "Ascending echoes",pitch_change,  0.0,   0.999,  0.4,    0.2599, 35.0,   120.0},
{ "Phase shift", phase_shift,       0.999,  0.999, 0.0,    1.0,    4.0,    100.0},
{ "Slow invert phase shift with feedback",
                   phase_shift,    0.999,  -0.999, -0.6,   0.2,    6.0,    100.0},
{ "Noise gate",    noise_gate,     NA,     NA,     NA,     500.0,  0.05,   NA},
{ "Straight Thru", thru,           NA,     NA,     NA,     NA,     NA,     NA},
};
*)
//#define NPROGS (sizeof(programs) / sizeof(struct program))
// globals
var
   SampleRate: Longint;            // sample rate set by init_1848 */
   Buf: array[0..BFSZ-1] of Double;// buffer used by delay based effects */
(*=======================================================================
                                noise_gate
    Super simple noise gate to demonstrate how much of the hiss
    comes directly from the ADC on this card, but how quiet the
    DACs are by comparison.
    Only parms are:
        rate        decay time in ms
        depth       threshold for turn on
========================================================================*)
procedure noise_gate(p: PProgram);
var
   inval,decay_fac,gain: Double;
   data: tbw;
   scan: Longint;
begin
    gain := 0;
    scan := 0;
    // calculate decay factor for 20db atten in spec'd time
    decay_fac := pow(10.0,1.0 / ((p^.rate/1000.0) * SampleRate));
    decay_fac := 1.0 / decay_fac;
    // disable interrupts, go to it
    while (True) do
    begin
       while((inp(SR) & 0x20) == 0);       // wait for input ready
       data.b[0] := inp(PDR);              // read input from chip
       data.b[1] := inp(PDR);
       inval := data.w;
       if (inval > p^.depth) then      // see if we crossed threshold
           gain := 1.0;                // turn gate on */
       data.w := (inval * gain);
       while((inp(SR) & 0x2) == 0);    // wait for output ready */
       outp(PDR,data.b[0]);            // write output to chip */
       outp(PDR,data.b[1]);
       gain := gain * decay_fac;       // adjust attenuation */
    end;
end;
(*=======================================================================
                                flange_chorus
    Does flanging/chorusing family of effects based on a single
    varying delay.
    dry_mix     mix of unaffected signal (-0.999 to 0.999)
    wet_mix     mix of affected signal (-0.999 - 0.999)
    feedback    amount of recirculation (-0.9 - 0.9)
    rate        rate of delay change in millisecs per sec
    sweep       sweep range in millisecs
    delay       fixed additional delay in millisecs
========================================================================*)
procedure flange_chorus(p: PProgram);
var
   fp,ep1,ep2: integer;
   step,depth,delay,min_sweep,max_sweep: integer;
   inval,outval,ifac: Double;
   scan: Longint;
   data:  Tbw;
   sweep: Twl;
begin
   ifac := 65536.0;
   scan := 0;
   // fetch params
   step := p^.rate * 65.536;
   depth := p^.depth * SampleRate div 1000;
   delay := p^.delay * SampleRate div 1000;
   // init/calc some stuff
   max_sweep := BFSZ - 2 - delay;
   min_sweep := max_sweep - depth;
   if (min_sweep < 0) then
   begin
        printf("Can't do that much delay or depth at this sample rate.n");
        exit(1);
   end;
   sweep.w[1] := (min_sweep + max_sweep) div 2;
   sweep.w[0] := 0;
   // init store and read ptrs to known value
   fp := 0;
   ep1 := 0;
   ep2 := 0;
    while (True) do
    begin
        data.b[0] := inp(PDR);               /* read input from chip */
        data.b[1] := inp(PDR);
        // interpolate from the 2 read values
        outval := (Buf[ep1]*sweep.w[0]+
                   Buf[ep2]*(ifac-sweep.w[0]))/ifac;
        // store finished input plus feedback
        inval := data.w + outval * p^.feedback;
        Buf[fp] := inval;
        // develop final output mix
        outval := outval * p^.wet_mix + inval * p^.dry_mix;
        if (outval > 32767.0) then
            data.w := 32767
        else if (outval < -32768.0) then
            data.w := -32768;
        else
            data.w := outval;
        outp(PDR,data.b[0]);                // write output to chip
        outp(PDR,data.b[1]);
        // update ptrs
        fp := (fp + 1) and (BFSZ - 1);
        sweep.l := sweep.l + step;
        ep1 := (fp + sweep.w[1]) and (BFSZ - 1);
        ep2 := (ep1 - 1) and (BFSZ - 1);
        // check for sweep reversal
        if (sweep.w[1] > max_sweep) or   // see if we hit top of sweep
           (sweep.w[1] < min_sweep) then // or if we hit bottom of sweep */
            step := -step;               // reverse
    end;
end;
(*=======================================================================
                                pitch_change
    dry_mix     mix of unaffected signal (-0.999 to 0.999)
    wet_mix     mix of affected signal (-0.999 - 0.999)
    feedback    amount of recirculation (-0.9 - 0.9)
    rate        amount of pitch change (see table below for values)
    depth       sweep range in millisecs for generating pitch shift
    delay       fixed additional delay
    Semitones      Up              Down
        1       0.059463        -0.056126
        2       0.122462        -0.109101
        3       0.189207        -0.159104
        4       0.259921        -0.206299
        5       0.334840        -0.250846
        6       0.414214        -0.292893
        7       0.498307        -0.332580
        8       0.587401        -0.370039
        9       0.681793        -0.405396
        10      0.781797        -0.438769
        11      0.887749        -0.470268
        12      1.000000        -0.500000
=======================================================================*)
procedure pitch_change(p: PPRogram);
var
   fp,ep1,ep2,ep3,ep4: integer;
   depth,delay,min_sweep,max_sweep,sweep_up: integer;
   i,step,xfade,xfade_cnt,active,active_cnt,chanA: integer;
   scan: Longint;
   inval,outval,comp,ifac: Double;
   blendA,blendB: Double;
   fadeA,fadeB: ^Double;
   fade_out,fade_in: array[0..MAX_XTAB-1] of Double;
   data: Tdw;
   sweep: tlw;
begin
   scan := 0;
   ifac := 65536.0;
    // fetch params
    step := p^.rate * 65535.0;
    sweep_up := 1;
    depth := (p^.depth * SampleRate div 1000;
    delay := (p^.delay * SampleRate div 1000;
    xfade := 12 * SampleRate div 1000;
    // init/calc some stuff
    max_sweep := BFSZ - 2 - delay;
    min_sweep := max_sweep - depth;
    active := max_sweep - min_sweep - (xfade * p^.rate) - 2;
    if (xfade > MAX_XTAB) then
    begin
        printf("Can't do pitch change crossfade at this sample rate.n");
        exit(1);
    end;
    if (min_sweep < 0) then
    begin
        printf("Can't do that much delay or depth at this sample rate.n");
        exit(1);
    end;
    // build the crossfade lookup tables
    for i := 0 to xfade-1 do
    begin
       fade_in[i] := cos(i * M_PI_2 / xfade);
       fade_out[i] := sin(i * M_PI_2 / xfade);
    end;
    // init store and read ptrs to known value, chanA active 1st
    fp := 0;
    ep3 := 0;
    ep4 := 0;
    xfade_cnt := 0;
    sweep.l := 0;
    if (sweep_up) then
    begin
        ep1 := min_sweep;
        ep2 := min_sweep;
    end
    else
    begin
       ep1 := max_sweep;
       ep2 := max_sweep;
    end;
    active_cnt := active;
    blendA := 1.0;
    blendB := 0.0;
    fadeA := fade_out;
    fadeB := fade_in;
    chanA := True;
    while (True) do
    begin
        data.b[0] = inp(PDR);               /* read input from chip */
        data.b[1] = inp(PDR);
        // messy expression to interpolate from both pairs of read ptrs
        comp := ifac - sweep.w[0];
        outval := ((Buf[ep1] * sweep.w[0] + Buf[ep2] * comp) * blendA +
                   (Buf[ep3] * sweep.w[0] + Buf[ep4] * comp) * blendB)
                   / ifac;
        // store finished input plus feedback
        inval := data.w + outval * p^.feedback;
        Buf[fp] := inval
        // develop final output mix
        outval := outval * p^.wet_mix + inval * p^.dry_mix;
        if (outval > 32767.0) then               // clip output if necessary
            data.w := 32767;
        else if(outval < -32768.0) then
            data.w := -32768;
        else
            data.w := outval;
        outp(PDR,data.b[0]);                /* write output to chip */
        outp(PDR,data.b[1]);
        // see if crossfade active
        if (xfade_cnt > 0) then
        begin
            dec(xfade_cnt);
            blendA := fadeA[xfade_cnt];
            blendB := fadeB[xfade_cnt];
        end;
        // update store ptr
        inc_index(fp);
        // see which direction
        if (sweep_up) then
        begin
            // update sweep
            sweep.l := sweep.l + word(step);
            // always inc at least once
            inc_indexes(ep1,ep2);
            inc_indexes(ep3,ep4);
            // if sweep didn't overflow, we're done
            if(sweep.w[1] = 0) continue;
            // sweep overflowed, inc again
            inc_indexes(ep1,ep2);
            inc_indexes(ep3,ep4);
            sweep.w[1] := 0;
            // see if it's time to switch over to other delay channel
            dec(active_cnt);
            if (active_cnt = 0) then
            begin
                xfade_cnt := xfade;      // initiate crossfade */
                active_cnt := active;    // start counter on new channel */
                if (chanA) then              // A has been active, go to B */
                begin
                   chanA = FALSE;
                   ep3 := (fp + min_sweep) and (BFSZ - 1);
                   fadeA := fade_out;
                   fadeB := fade_in;
                end
                else
                begin
                   chanA := TRUE;
                   ep1 := (fp + min_sweep) and (BFSZ - 1);
                   fadeB := fade_out;
                   fadeA := fade_in;
                end;
            end;
        end
        else  // do downward sweep
        begin
           sweep.l := sweep.l + step;   // update sweep
           // if sweep didn't overflow, inc ptrs, that's all
           if (sweep.w[1] = 0) then
           begin
              inc_indexes(ep1,ep2);
              inc_indexes(ep3,ep4);
              continue;
           end;
           // sweep overflowed, check on stuff but skip ptr inc
           sweep.w[1] := 0;
           // see if it's time to switch over to other delay channel
           dec(active_cnt);
            if(active_cnt = 0) then
            begin
               xfade_cnt := xfade;
               active_cnt := active;
               if(chanA) then       // A has been active, go to B */
               begin
                  chanA := FALSE;
                  ep3 := (fp + max_sweep) and (BFSZ - 1);
                  fadeA := fade_out;
                  fadeB := fade_in;
               end
               else
               begin
                  chanA := TRUE;
                  ep1 := (fp + max_sweep) and (BFSZ - 1);
                  fadeB := fade_out;
                  fadeA := fade_in;
               end;
            end;
        end
    end;
end;
(*=======================================================================
                                phase_shift
    Digital version of the popular '70s effect.  This one
    does 4 stages just like old MXR Phase 90 stompbox.
    dry_mix     mix of unaffected signal (-0.999 to 0.999)
    wet_mix     mix of affected signal (-0.999 - 0.999)
    feedback    amount of recirculation (-0.9 - 0.9)
    rate        rate of sweep in cycles per second
    depth       sweep range in octaves
    delay       base frequency of sweep
=======================================================================*)
procedure phase_shift(p: PProgram);
var
   wp,min_wp,max_wp,range,coef,sweepfac: Double;
   inval,x1,outval: Double;
   lx1,ly1,lx2,ly2,lx3,ly3,lx4,ly4: Double;
   data: Tdw;
begin
   outval := 0.0;
   // calc params for sweeping filters
   min_wp := (M_PI * p^.delay) / SampleRate;
   wp := min_wp;
   range := pow(2.0,p^.depth);
   max_wp := (M_PI * p^.delay * range) / SampleRate;
   p^.rate := pow(range,p^.rate / (SampleRate / 2));
   sweepfac := p^.rate;
   while (True) do
   begin
      coef := (1.0 - wp) / (1.0 + wp);   // calc coef for current freq
      data.b[0] = inp(PDR);               /* read input from chip */
      data.b[1] = inp(PDR);
      inval := data.w + p^.feedback * ly4;
      x1 := inval;
      ly1 := coef * (ly1 + x1) - lx1;     // do 1st filter
      lx1 := x1;
      ly2 := coef * (ly2 + ly1) - lx2;    // do 2nd filter
      lx2 := ly1;
      ly3 := coef * (ly3 + ly2) - lx3;    // do 3rd filter
      lx3 := ly2;
      ly4 := coef * (ly4 + ly3) - lx4;    // do 4th filter
      lx4 := ly3;
      // develop final output mix
      outval := ly4 * p^.wet_mix + inval * p^.dry_mix;
      if (outval > 32767.0) then          // clip output if necessary
          data.w := 32767
      else if (outval < -32768.0) then
          data.w := -32768
      else
          data.w := outval;
      outp(PDR,data.b[0]);                // write output to chip
      outp(PDR,data.b[1]);
      wp := wp * sweepfac;                // adjust freq of filters
      if (wp > max_wp) then               // max?
          sweepfac := 1.0 / p^.rate       // sweep back down
      else if (wp < min_wp) then          // min?
          sweepfac := p^.rate;            // sweep back up
   end;
end;

						