effect.pas

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