![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
|
|
#1
|
|||
|
|||
|
Помогите разобраться откуда ошибка появляется в этом простейшем примере? (смысл примера - пищит 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.Замечу что точно такой же код но в консольном приложении работает без замечаний.. Приклею и саму программу и консольную версию.. |
|
#2
|
||||
|
||||
|
Непонятно, что освобождает эта строка:
Код:
VirtualFree(@second,0,MEM_RELEASE); |
|
#3
|
||||
|
||||
|
Я взял и удалил все .dcu и .exe файлы, перекомпилил - и программа заработала без ошибок. Так иногда бывает после "экспериментов".
|
|
#4
|
|||
|
|||
|
пасиб за ответ, но у меня удаление не дало ничего... Вот зато подсказали правильное решение на другом форуме..
Переменная этого типа не может быть объявлена локально в этой процедуре. Не спрашивайте "почему?" не знаю (может кто из знатоков подскажет). Знаю только что FillChar при каждой итерации обнуляет управляющую переменную I. Цикл становится бесконечным - ошибка обеспечена. Выносим объявление массива за пределы процедуры. Может еще есть какой способ, но найден пока такой. Код: Код:
var hdr: array[0..2] of WAVEHDR; procedure TForm1.Button1Click(Sender: TObject); var i: integer; wout: hWaveOut; fmt: tWAVEFORMATEX; begin ... |
|
#5
|
||||
|
||||
|
Ну да, я забыл, перед этим я исправил в строке
Код:
fillChar(hdr[i], sizeof(hdr), 0); Код:
fillChar(hdr[i], sizeof(hdr[i]), 0); ![]() PS: мож только у меня такой глюк, но [B ]hdr[i][ /B] - это виделение жирным( |
|
#6
|
||||
|
||||
|
Цитата:
. Кака одним словом. |
|
#7
|
||||
|
||||
|
Цитата:
Код:
VirtualFree(@second,0,MEM_RELEASE); |
|
#8
|
|||
|
|||
|
Цитата:
не работает.. а вот если вынести то все норм.. |