effect.pas

   1 unit effect;
   2
   3 interface
   4
   5 uses System.Classes, System.SysUtils, Math, spWav;
   6
   7 function effect16BitWav(const sp: SpParam): integer;
   8 function sinc(x: Single): Single;
   9 function effectwav(const sp: SpParam): integer;
  10
  11 implementation
  12
  13 uses Unit2;
  14
  15 function effect16BitWav(const sp: SpParam): integer;
  16 const
  17   j = 24;
  18 var
  19   i, k, a, b, pmin, pmax: integer;
  20   len, temp_size, offset0, offset1, p, q: integer;
  21   m, ma, pitch, rate: Single;
  22   pMem, pCpy, pRes: array of SmallInt;
  23   s: TMemoryStream;
  24   r: array of Single;
  25 begin
  26   result := 0;
  27   try
  28     temp_size := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.01);
  29     pmin := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.005);
  30     pmax := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.02);
  31     SetLength(r, pmax - pmin);
  32     offset0 := 0;
  33     offset1 := 0;
  34     rate := 0.66;
  35     len := trunc(sp.sizeOfData - sp.posOfData / (rate * sp.channels));
  36     SetLength(pCpy, len);
  37     SetLength(pRes, len);
  38     SetLength(pMem, len);
  39     s := TMemoryStream.Create;
  40     s.Write(sp.pWav^, sp.sizeOfData);
  41     s.Position := sp.posOfData;
  42     s.Read(Pointer(pRes)^, s.Size);
  43     s.Position := sp.posOfData;
  44     s.Read(Pointer(pCpy)^, s.Size);
  45     s.Free;
  46     ma := 0.0;
  47     p := pmin;
  48     for b := 0 to pmax - pmin - 1 do
  49     begin
  50       r[b] := 0.0;
  51       for a := 0 to temp_size do
  52         r[b] := r[b] + pRes[a] * pRes[a + b];
  53       if r[b] > ma then
  54       begin
  55         ma := r[b];
  56         p := b;
  57       end;
  58     end;
  59     while offset1 + 2 * pmax < len do
  60     begin
  61       for i := 0 to p do
  62       begin
  63         pCpy[offset1 + i] := pRes[offset0 + i];
  64         pCpy[offset1 + i + p] :=
  65           trunc((pRes[offset0 + p + i] * (p - i) + pRes[offset0 + i] * i) / p);
  66       end;
  67       q := trunc(rate * p / (1.0 - rate) + 0.5);
  68       for i := p to q - 1 do
  69       begin
  70         if offset1 + p + i >= len then
  71           break;
  72         pCpy[offset1 + p + i] := pRes[offset0 + i];
  73       end;
  74       inc(offset0, q);
  75       inc(offset1, p + q);
  76     end;
  77     pitch := 1.5;
  78     k := trunc(len / pitch);
  79     for i := 0 to k - 1 do
  80     begin
  81       m := pitch * i;
  82       q := trunc(m);
  83       for a := q - j div 2 to q + j div 2 do
  84         if (a >= 0) and (a < len) then
  85           pMem[i] := pCpy[a] + pRes[a] * trunc(sinc(pi * (m - a)))
  86         else
  87           pMem[i] := 0;
  88     end;
  89   except
  90     result := -1;
  91   end;
  92   s := TMemoryStream.Create;
  93   try
  94     s.Write(sp.pWav^, sp.posOfData);
  95     s.Write(Pointer(pMem)^, sp.sizeOfData - sp.posOfData);
  96     s.Position := 0;
  97     s.Read(sp.pWav^, s.Size);
  98   finally
  99     s.Free;
 100   end;
 101   Finalize(pRes);
 102   Finalize(pCpy);
 103   Finalize(pMem);
 104   Finalize(r);
 105 end;
 106
 107 function sinc(x: Single): Single;
 108 begin
 109   if x = 0 then
 110     result := 1.0
 111   else
 112     result := sin(x) / x;
 113 end;
 114
 115 function effectwav(const sp: SpParam): integer;
 116 begin
 117   if sp.channels = 1 then
 118   begin
 119     Form2.ListBox1.Items.Add('\83X\83e\83\8c\83I\83t\83@\83C\83\8b\82É\82µ\82Ä\82\82¾\82³\82¢');
 120     result := -1;
 121   end
 122   else
 123     result := effect16BitWav(sp);
 124 end;
 125
 126 end.