OSDN Git Service

とても難しい概念が出てきます
authoryamat0jp <yamat0jp@yahoo.co.jp>
Fri, 18 May 2018 09:20:22 +0000 (18:20 +0900)
committeryamat0jp <yamat0jp@yahoo.co.jp>
Fri, 18 May 2018 09:20:22 +0000 (18:20 +0900)
動作していません

effect.pas
wav_proj.dpr

index 3b9e699..4366d94 100644 (file)
@@ -24,9 +24,10 @@ begin
   result := 0;
   try
     s := TMemoryStream.Create;
-    s.ReadBuffer(sp.pWav^, sp.sizeOfData);
+    s.Write(sp.pWav^, sp.sizeOfData);
+    s.Position := 0;
+    s.Read(Pointer(pCpy)^, sp.sizeOfData);
     pMem := sp.pWav;
-    pCpy := s.Memory;
     i := sp.posOfData;
     k := 8 * sp.sizeOfData / sp.bitsPerSample;
     while i < k do
@@ -39,16 +40,18 @@ begin
   except
     result := -1;
   end;
+  s.Free;
+  Finalize(pCpy);
 end;
 
 function effect16BitWav(const sp: SpParam): integer;
 const
-  depth = 1.0;
-  rate = 170.0;
+  j = 24;
 var
-  i: integer;
-  k, m: Single;
+  i, a, b, pmin, pmax, temp_size, offset0, offset1, p, q: integer;
+  k, m, max, pitch, rate: Single;
   pMem, pCpy: array of SmallInt;
+  r: array of Single;
   s: TMemoryStream;
 begin
   result := 0;
@@ -61,16 +64,63 @@ begin
     pMem := sp.pWav;
     i := sp.posOfData;
     k := 8 * sp.sizeOfData / sp.bitsPerSample;
+    temp_size := trunc(sp.samplePerSec * 0.01);
+    pmin := trunc(sp.samplePerSec * sp.bitsPerSample * 0.005);
+    pmax := trunc(sp.samplePerSec * sp.bitsPerSample * 0.02);
+    SetLength(r, pmax - pmin);
+    offset0 := sp.posOfData;
+    offset1 := sp.posOfData;
+    rate := 1.5;
+    while offset0 + pmax * 2 < sp.sizeOfData do
+    begin
+      max := 0.0;
+      p := pmin;
+      for b := pmin to pmax do
+      begin
+        r[b] := 0.0;
+        for a := sp.posOfData to sp.posOfData + temp_size do
+          r[b] := r[b] + pMem[a] * pCpy[a + b];
+        if r[b] > max then
+        begin
+          max := r[b];
+          p := b;
+        end;
+      end;
+      for i := 0 to p do
+      begin
+        pMem[offset1 + i] := trunc(pCpy[offset0 + i]);
+        pMem[offset1 + i + p] := trunc(pCpy[offset0 + i + p] * (p - i) / p) +
+          trunc(pCpy[offset0 + p + i] * i / p);
+      end;
+      inc(offset0, q);
+      inc(offset1, p + q);
+    end;
+    q := trunc(p / (rate - 1) + 0.5);
+    for i := p to q do
+    begin
+      if offset0 + p + i > sp.sizeOfData then
+        break;
+      pMem[offset1 + p + i] := pCpy[offset0 + i];
+    end;
+    pitch := 0.66;
     while i < k do
     begin
-      m := depth * sin(2 * rate * pi * i / sp.samplePerSec);
-      pMem[i + 0] := trunc(m * pMem[i + 0]);
-      pMem[i + 1] := trunc(m * pMem[i + 1]);
+      m := pitch * i;
+      q := trunc(m);
+      for a := q - j div 2 to q + j div 2 do
+        if (m >= sp.posOfData) and (m < sp.sizeOfData) then
+        begin
+          pMem[a + 0] := trunc(pMem[a + 0] + pCpy[a + 0] *
+            ArcSin(pi * (m - a)));
+          pMem[a + 1] := trunc(pMem[a + 1] + pCpy[a + 1] *
+            ArcSin(pi * (m - a)));
+        end;
       inc(i, 2);
     end;
   except
     result := -1;
   end;
+  Finalize(r);
   s.Free;
   Finalize(pCpy);
 end;
index a59ce19..c710e44 100644 (file)
@@ -17,15 +17,6 @@ var
   pMem: TMemoryStream;
   fileName: string;
 
-function getPara(var sp: SpParam): integer;
-var
-  i: integer;
-begin
-  sp.pWav:=pMem.Memory;
-  sp.cyclicSec:=i;
-  result:=0;
-end;
-
 begin
   try
     { TODO -oUser -cConsole \83\81\83C\83\93 : \82±\82±\82É\83R\81[\83h\82ð\8bL\8fq\82µ\82Ä\82­\82¾\82³\82¢ }
@@ -34,11 +25,7 @@ begin
       Exit;
     if readWav(ParamStr(1), pMem) = false then
       Exit;
-    if getPara(sp) = -1 then
-    begin
-      pMem.Free;
-      Exit;
-    end;
+    sp.pWav := pMem.Memory;
     if effectWav(sp) = 0 then
     begin
       PlaySound(pMem.Memory, 0, SND_ASYNC or SND_NODEFAULT or SND_MEMORY);