[JekaDefer]

Помогите разобраться откуда ошибка появляется в этом простейшем примере? (смысл примера - пищит 3 секунды непрерывно, каждая секунда на другой частоте, но по завершению откуда-то вылезает ошибка) Весь код:

Код:

unit Unit1;

interface

uses
  Windows, Forms, MMSystem, Classes, Controls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  const
  sps	= 44100;	// samples per second
  freq1	= 1000;	 	// signal frequency (Hz)
  freq2	= 900;	 	// signal frequency (Hz)
  freq3	= 1200;	 	// signal frequency (Hz)
  time1	= 1000;		// time of signal (ms)
  time2	= 1000;		// time of signal (ms)
  time3	= 1000;		// time of signal (ms)
  Volume1 = 32767;
  Volume2 = 32767;
  Volume3 = 32767;

type
  int16 = smallint;

var
  Form1: TForm1;
  second: array[0..2, 0..sps] of int16;	// full second
implementation

{$R *.dfm}
procedure prepareSine();
var
  i, nSamples: Integer;
  angle, delta: double;
begin
  nSamples := sps * time1 div 1000;	// signal length in samples
  //
  angle := 0;
  delta := (freq1 / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    second[0, i] := round(sin(angle) * Volume1);
    angle := angle + delta;
  end;

  nSamples := sps * time2 div 1000;	// signal length in samples
  //
  angle := 0;
  delta := (freq2 / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    second[1, i] := round(sin(angle) * Volume2);
    angle := angle + delta;
  end;

  nSamples := sps * time3 div 1000;	// signal length in samples
  //
  angle := 0;
  delta := (freq3 / sps) * 2 * Pi;	// how much in one sample
  //
  for i := 0 to nSamples - 1 do begin
    //
    second[2, i] := round(sin(angle) * Volume3);
    angle := angle + delta;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  wout: hWaveOut;
  fmt: tWAVEFORMATEX;
  hdr: array[0..2] of WAVEHDR;
begin
  prepareSine();
  //
  With fmt do
  Begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := SPS;
    wBitsPerSample := 16;
    nBlockAlign := nChannels*wBitsPerSample div 8;
    nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
    cbSize := 0;
  End;
  //
  WaveOutOpen(@wout, cardinal(-1), @fmt, 0, 0, 0);
  if (0 <> wout) then
  begin
    //
    for i := 0 to 2 do
    begin
      //
      fillChar(hdr[i], sizeof(hdr), #0);
      hdr[i].lpData := @second[i];
      hdr[i].dwBufferLength := sizeof(second[i]);
      //
      waveOutPrepareHeader(wout, @hdr[i], sizeof(hdr[i]));
      WaveOutWrite(wout, @hdr[i], sizeof(hdr[i]));
    end;
    //
    Sleep(3100);	// sleep for 3 seconds
    //
    waveOutUnprepareHeader(wout, @hdr, sizeof(TWAVEHDR));
    VirtualFree(@second,0,MEM_RELEASE);
    WaveOutClose(wout);
  end;
end;

end.

Замечу что точно такой же код но в консольном приложении работает без замечаний.. Приклею и саму программу и консольную версию..

[angvelem]

Непонятно, что освобождает эта строка:

Код:

    VirtualFree(@second,0,MEM_RELEASE); 

[YVitaliy]

Я взял и удалил все .dcu и .exe файлы, перекомпилил - и программа заработала без ошибок. Так иногда бывает после "экспериментов".

[JekaDefer]

пасиб за ответ, но у меня удаление не дало ничего... Вот зато подсказали правильное решение на другом форуме..

Переменная этого типа не может быть объявлена локально в этой процедуре. Не спрашивайте "почему?" не знаю (может кто из знатоков подскажет). Знаю только что FillChar при каждой итерации обнуляет управляющую переменную I. Цикл становится бесконечным - ошибка обеспечена. Выносим объявление массива за пределы процедуры. Может еще есть какой способ, но найден пока такой.
Код:

Код:

var
  hdr: array[0..2] of WAVEHDR;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  wout: hWaveOut;
  fmt: tWAVEFORMATEX;
begin
   ...

[YVitaliy]

Ну да, я забыл, перед этим я исправил в строке

Код:

fillChar(hdr[i], sizeof(hdr), 0);

на

Код:

fillChar(hdr[i], sizeof(hdr[i]), 0);

.

PS: мож только у меня такой глюк, но [B ]hdr[i][ /B] - это виделение жирным(

[angvelem]

...Знаю только что FillChar при каждой итерации обнуляет управляющую переменную I...

Ничего подобного не происходит, переменная вполне может быть локальной. Исправь ошибку как пишет YVitaliy и удали не используемую строку

Код:

   VirtualFree(@second,0,MEM_RELEASE); 

[angvelem]

Сообщение от YVitaliy

PS: мож только у меня такой глюк, но [B ]hdr[i][ /B] - это виделение жирным(

Используемый ныне JavaScript не позволяет ничего выделять в коде . Кака одним словом.

[JekaDefer]

Сообщение от angvelem

Ничего подобного не происходит, переменная вполне может быть локальной. Исправь ошибку как пишет YVitaliy и удали не используемую строку

Код:

   VirtualFree(@second,0,MEM_RELEASE); 

не работает.. а вот если вынести то все норм..

[angvelem]

Не пудри мозги себе и другим, всё работает:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  I    : integer;
  wout : hWaveOut;
  fmt  : tWAVEFORMATEX;
  hdr  : array[0..2] of WAVEHDR;
begin
  prepareSine;

  with fmt do
  Begin
    wFormatTag      := WAVE_FORMAT_PCM;
    nChannels       := 1;
    nSamplesPerSec  := SPS;
    wBitsPerSample  := 16;
    nBlockAlign     := nChannels * wBitsPerSample div 8;
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
    cbSize          := 0;
  end;

  WaveOutOpen(@wout, Cardinal(-1), @fmt, 0, 0, 0);

  if wout <> 0 then
  begin
    for I := 0 to High(hdr) do
    begin
      FillChar(hdr[i], sizeof(hdr[i]), #0);
      hdr[i].lpData := @second[i];
      hdr[i].dwBufferLength := SizeOf(second[i]);

      waveOutPrepareHeader(wout, @hdr[i], SizeOf(hdr[i]));
      WaveOutWrite(wout, @hdr[i], SizeOf(hdr[i]));
    end;

    Sleep(3100);	// sleep for 3 seconds

    waveOutUnprepareHeader(wout, @hdr, SizeOf(WAVEHDR));
    WaveOutClose(wout);
  end;
end;

[JekaDefer]

Ну да работает но только со Sleep 3001. А с тем кодом Sleep не нужен.

[angvelem]

Ну так разберись, что тебе нужно. Ты выложил конкретный код, тебе дали конкретный ответ, а уж что ты там дальше наэкспериментируешь никому неизвестно.