Как избавиться от щелчков при синтезировании мелодий?

[ArcaN0id]

Есть 2 программы. В одной реализованно создание мелодии и запись ее в wav файл. Так вот проблема в том что после каждой ноты слышен щелчок..как от него избавиться?
Во второй программе тоже самое только с аккордами....

[BaronTreep]

Когда в звуковом редакторе просто компонуешь фрагменты звуковых форм образуются щелчки (спектральный перепад), существуют специальные опции там, которые их зглаживают.

Соответственно я вижу, что вы пишете сначала одну синусоиду, потом другую, без промежуточного расчета плавного перехода...

Работа со звуком в Дельфи - это что называется "попробуй найди"...

[ArcaN0id]

так вот как сделать эти переходы?

[BaronTreep]

Послушал ещё раз. Таких щелчков вообще не должно получаться.

Сначала КРАСИВО напишите всё в такой МОДУЛЬ, и подключите его в uses (больше не надо mmsystem).

unit WAV;

interface

uses
  SysUtils, Classes, mmsystem, math;

Const
    noError            = 0;
    ReadError          = 1;
    HeaderError        = 2;
    DataError          = 3;
    FileCorrupt        = 4;
    IncorectFileFormat = 5;
    HeaderWriteError   = 6;
    StreamError        = 7;

type TWaveResult = record
    ERROR          : WORD;
    wAvgBytesPerSec: Cardinal;
    wBitsPerSample : WORD;
    wChannels      : WORD;
    Data           : TMemoryStream;
    wSamplesPerSec : Cardinal;
end;

type TWaveHeaderChank = record
    wFormatTag     : Smallint;
    wChannels      : WORD;
    wSamplesPerSec : Cardinal;
    wAvgBytesPerSec: Cardinal;
    wBlockAlign    : WORD;
    wBitsPerSample : WORD;
    wcbSize        : WORD;
  end;

// Вообще не экспортируем ReadWave и WriteWave
Procedure Play(FileName : String); 
Procedure Sinus(FileName : String; r : TWaveResult; frec, Amp : Real; Time : Word);
Procedure SinusAmp12(FileName : String; r : TWaveResult; frec, Amp1, Amp2 : Real);
Procedure SinusFrec12(FileName : String; r : TWaveResult; frec1, frec2, Amp : Real);

implementation

Procedure Play(FileName : String);
begin
  if FileExists(FileName) then
    PlaySound('sample.wav', 0, SND_ASYNC)
end;

Function ReadWave(FileName : String) : TWaveResult;
var
  f             : TFileStream;
  wFileSize     : Cardinal;
  wChankSize    : Cardinal;
  ID            : array[0..3] of Char;
  Header        : TWaveHeaderChank;
  RealFileSize  : Cardinal;
Begin
  if not FileExists(FileName) then Exit;
  FillChar(Result, SizeOf(Result), 0);
  Try
    f := TFileStream.Create(FileName, fmOpenRead);
    f.Seek(0, soFromBeginning);
    f.ReadBuffer(ID[0], 4);
    if String(ID) <> 'RIFF' then Begin
        Result.ERROR := IncorectFileFormat;
        f.Free;
        exit;
    end;
    f.ReadBuffer(wFileSize, 4);
    if f.size <> (wFileSize + 8) then Begin
        Result.ERROR := FileCorrupt;
        f.Free;
        exit;
    end;
    f.ReadBuffer(ID[0], 4);
    if String(ID) <> 'WAVE' then Begin
        Result.ERROR := IncorectFileFormat;
        f.Free;
        exit;
    end;
    wChankSize := 0;
    repeat
      f.Seek(wChankSize, soFromCurrent);
      f.ReadBuffer(ID[0], 4);
      f.ReadBuffer(wChankSize, 4);
      if wChankSize > High(integer) then Begin
          Result.ERROR := DataError;
          f.Free;
          exit;
      end;
    until  (String(ID)='fmt ') or (String(ID)='data');
    if String(ID)='data' then Begin
        Result.ERROR := HeaderError;
        f.Free;
        exit;
    end;
    f.ReadBuffer(Header, Min(wChankSize, SizeOf(TWaveHeaderChank)));
    if wChankSize > SizeOf(TWaveHeaderChank) then
       f.Seek(wChankSize - SizeOf(TWaveHeaderChank), soFromCurrent);
    if wChankSize >= SizeOf(TWaveHeaderChank) then
    wChankSize := 0;
    repeat
      f.Seek(wChankSize, soFromCurrent);
      f.ReadBuffer(ID[0], 4);
      f.ReadBuffer(wChankSize, 4);
    until  String(ID)='data';
    Result.ERROR           := noError;
    Result.wAvgBytesPerSec := Header.wAvgBytesPerSec;
    Result.wBitsPerSample  := Header.wBitsPerSample;
    Result.wChannels       := Header.wChannels;
    Result.Data := TMemoryStream.Create;
    Result.Data.Seek(0, soFromBeginning);
    Result.Data.Size := wChankSize;
    f.ReadBuffer(Result.Data.Memory^, wChankSize);
  Except
    Result.ERROR := ReadError;
  end;
  f.Free;
end;

[BaronTreep]

Продолжение:

Function WriteWave(FileName : String; data : TWaveResult) : WORD;
var
  f             : TFileStream;
  wFileSize     : Cardinal;
  wChankSize    : Cardinal;
  ID            : array[0..3] of Char;
  Header        : TWaveHeaderChank;
Begin
  Result := noError;
  Try
    f := TFileStream.Create(FileName, fmCreate);
    f.Seek(0, soFromBeginning);
    Header.wFormatTag     := 1;
    Header.wChannels      := data.wChannels;
    Header.wSamplesPerSec := data.wSamplesPerSec;
    Header.wBlockAlign    := data.wChannels * (data.wBitsPerSample div 8);
    Header.wAvgBytesPerSec:= data.wSamplesPerSec * Header.wBlockAlign;
    Header.wBitsPerSample := data.wBitsPerSample;
    Header.wcbSize        := 0;
    ID := 'RIFF';
    f.WriteBuffer(ID, 4);
    wFileSize := 0;
    f.WriteBuffer(wFileSize, 4);
    ID := 'WAVE';
    f.WriteBuffer(ID, 4);
    ID := 'fmt ';
    f.WriteBuffer(ID, 4);
    wChankSize := SizeOf(Header);
    f.WriteBuffer(wChankSize, 4);
    f.WriteBuffer(Header, SizeOf(Header));
  except
    Result := HeaderWriteError;
  end;
  Try
    ID := 'data';
    f.WriteBuffer(ID, 4);
    wChankSize := data.Data.Size;
    f.WriteBuffer(wChankSize, 4);
    data.Data.Seek(0, soFromBeginning);
    f.CopyFrom(data.Data, data.Data.Size);
  except
    Result := StreamError;
  end;
  f.Seek(SizeOf(ID), soFromBeginning);
  wFileSize := f.Size - SizeOf(ID) - SizeOf(wFileSize);
  f.Write(wFileSize, 4);
  f.Free;
end;

Procedure Sinus(FileName : String; r : TWaveResult; frec, Amp : Real; Time : Word);
var
  i : word;
  d : Integer;
begin
  i := 0;
  while i < Time*r.wSamplesPerSec div 1000 do Begin
     d := Round(Amp * Sin(2*Pi*(frec*i/r.wSamplesPerSec)));
     r.Data.WriteBuffer(d, 2);
     inc(i);
  end;
  WriteWave('Sample.wav', r);
  r.Data.Create;
end;

Procedure SinusAmp12(FileName : String; r : TWaveResult; frec, Amp1, Amp2 : Real);
var
  i : word;
  d : Integer;
begin
  i := 0;
  while abs(Amp1) < abs(Amp2) do Begin
     d := Round(Amp1 * Sin(2*Pi*(frec*i/r.wSamplesPerSec)));
     r.Data.WriteBuffer(d, 2);
     Amp1:= Amp1 + 1;
     inc(i);
  end;
  WriteWave('Sample.wav', r);
  r.Data.Create;
end;

Procedure SinusFrec12(FileName : String; r : TWaveResult; frec1, frec2, Amp : Real);
var
  i : word;
  d : Integer;
begin
  i := 0;
  while abs(frec1) < abs(frec2) do Begin
     d := Round(Amp * Sin(2*Pi*(frec1*i/r.wSamplesPerSec)));
     r.Data.WriteBuffer(d, 2);
     frec1:= frec1 + 1;
     inc(i);
  end;
  WriteWave('Sample.wav', r);
  r.Data.Create;
end;

end.

Потом над кнопочкой делаем событие:

  Sinus('sample.wav', r, 10000, 20000, 500);  // Синусоида с Частотой, Амплитудой, и Временем в мс (не больше 1000 мс)
  Sinus('sample.wav', r, 500, 10000, 500);
  SinusAmp12('sample.wav', r, 600, 1000, 10000); // Перепад громкости от и до
  SinusFrec12('sample.wav', r, 800, 4000, 2000);  // Перепад частоты от и до
  SinusFrec12('sample.wav', r, 1000, 8000, 2000);
  SinusFrec12('sample.wav', r, 2000, 10000, 2000);
  SinusFrec12('sample.wav', r, 4000, 12000, 2000);
  SinusFrec12('sample.wav', r, 5000, 16000, 2000);
  SinusFrec12('sample.wav', r, 10000, 20000, 2000);
  SinusFrec12('sample.wav', r, 14000, 40000, 5000);

И слушаем настоящий синтетический звук:

  Play('sample.wav');  // Проиграть WAV

У меня даже не счёлкает.

[ArcaN0id]

у меня выдает ошибку в коде:

  Sinus('sample.wav', r, 10000, 20000, 500);  // Синусоида с Частотой, Амплитудой, и Временем в мс (не больше 1000 мс)
  Sinus('sample.wav', r, 500, 10000, 500);
  SinusAmp12('sample.wav', r, 600, 1000, 10000); // Перепад громкости от и до
  SinusFrec12('sample.wav', r, 800, 4000, 2000);  // Перепад частоты от и до
  SinusFrec12('sample.wav', r, 1000, 8000, 2000);
  SinusFrec12('sample.wav', r, 2000, 10000, 2000);
  SinusFrec12('sample.wav', r, 4000, 12000, 2000);
  SinusFrec12('sample.wav', r, 5000, 16000, 2000);
  SinusFrec12('sample.wav', r, 10000, 20000, 2000);
  SinusFrec12('sample.wav', r, 14000, 40000, 5000);

можете выложить уже готовую программу?

[BaronTreep]

Добавляю. Если не компилируется - дело не в коде. (Это действительно стоит услышать :-)