Текущий архив: 2007.03.11;
Скачать: CL | DM;

Вниз

WaveOut   Найти похожие ветки 

← →
Константинов ©   (2006-05-07 20:28) [0]

Реализован компонент - генератор синусоидальных сигналов использующих WinAPI
Компонент имеет свойство Duration – длительность звучания

Пытаюсь реализовать автоматический останов воспроизведения если время воспроизведения больше Duration, но выходит лажа:
Если вызвать метод Stop вручную ( щелчок накнопке формы, тестирующей компонент ) – все нормально, если вызвать этот же метод в DoLoopEvent то возникает какая-то ошибка во время выполнения WaveOutReset ( причем я не могу отловить код ошибки ) программа

Вот куски кода, подскажите где ошибка:

Открываем устройство:

procedure TGenerator.Open;
begin
 if fMode <> pmClose then Exit;   if WaveOutOpen(@fWaveOut,WAVE_MAPPER,fWaveFmtEx,DWORD(@WaveOutPrc),Integer(Self),CA LLBACK_FUNCTION) = MMSYSERR_NOERROR then fMode := pmOpen;
end;

Запускаем воспроизведение:

procedure TGenerator.Play;
 var I : integer;
begin
 fTabs := 0;
 fNext := true;
 for I := 0 to fBufCount - 1 do begin
   DoBuferEvent(fBuffer[I]);
   waveOutPrepareHeader(fWaveOut,fWaveHdr[I],SizeOf(WAVEHDR));
   WaveOutWrite(fWaveOut,fWaveHdr[I],SizeOf(WAVEHDR));
 end;
 fMode := pmPlay;
end;

Заполняем звуковые данные ( если пользователь желает, может сделать это сам иначе – автоматически
:
procedure TGenerator.DoBuferEvent(P: Pointer);
begin
 if Assigned(fOnBuferEvent)
   then fOnBuferEvent(Self,P)
   else SetBufer(P);
end;

CallBack проседуры:

procedure WaveOutPrc(hW:HWAVE; uMsg:DWORD;dwInstance:DWORD;dwParam1:DWORD;dwParam2:DWORD);stdcall;
begin
 TGenerator(dwInstance).WaveOutProc(hW,uMsg,dwParam1,dwParam2);
end;

procedure TGenerator.WaveOutProc(hW: HWAVE; uMsg, dwParam1,
 dwParam2: DWORD);
 var PWH : PWAVEHDR;
     BUF : PChar;
begin
 case uMSG of
   WOM_CLOSE: begin fWaveOut := 0;  end;
   WOM_DONE:
   begin
     PWH := Pointer(dwParam1);
     if PWH <> nil then
     begin
       BUF := PWH^.lpData;
       DoBuferEvent(BUF);
       if (BUF <> nil) and fNext  then WaveOutWrite(fWaveOut,PWH,SizeOf(WAVEHDR));
     end;
   end;
   end;
end;

Собственно сама процедура заполнения буферов:

procedure TGenerator.SetBufer(P: Pointer);
 var PS1, PS2 : ^smallint;
       I : integer;
procedure TGenerator.SetBufer(P: Pointer);
 var P1,P2 : ^byte;
     PS1, PS2 : ^smallint;
     I,N : integer;
Begin
 PS1 := P;
 PS2 := P;
 Inc(PS2);
 for I := 0 to (fBufCount div 4 ) - 1 do begin
     PS1^ := Round($7FFF * sin( (2 * PI * fFrequency / fSampleRate) * Tabs ));
     PS2^ := PS1^;
     Inc( Tabs);
     Inc(PS1,2);
     Inc(PS2,2);
     If Tabs > fDuration then DoLoopEvent;
 end;
End;

Собственно событие, возникающее при превышении длительности заданного интервала:

procedure TGenerator.DoLoopEvent(Channel: TPlayChannel);
begin
  if Assigned(fOnLoopEvent) then fOnLoopEvent(Self, Channel);
end;

процедура останова генератора:

procedure TGenerator.Stop;
begin
 if (fMode <> pmPlay) or (fNext = false) then Exit;
 fNext := false;
 WaveOutReset(fWaveOut);  
 fMode := pmOpen;
end;

процедура закрытия устройства:

procedure TGenerator.Close;
begin
//  if fMode <> pmOpen then Exit;
 if WaveOutClose(fWaveOut) = MMSYSERR_NOERROR then fMode := pmClose;
end;

Тестирование компонента:

var
 Form1: TForm1;
 gn : TGenerator;
implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
 gn := TGenerator.Create(self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 gn.Free;
end;

старт:

procedure TForm1.Button1Click(Sender: TObject);
begin
 gn.Left.Loop := false;
 gn.OnLoopEvent := Loop;
 gn.Open;
 gn.Play;
end;

останов вручную ( работает ):
procedure TForm1.Button2Click(Sender: TObject);
begin
 gn.Stop;
 gn.Close;
end;

попытка тоже самое сделать автоматически:
procedure TForm1.Loop(Sender: TObject; Channel: TPlayChannel);
begin
//  Button2.OnClick(Self);
end;

Проблема возникает в строке
WaveOutReset(fWaveOut);
метода Stop
устройство остается в режиме воспроизведения
( строка  fMode := pmOpen; - не выполняется )
в приложение остается в рабочем состоянии, но при последующих
попытках вызвать какие либо методы генератора ( Stop, Close, Open, Play ) приводит к зависанию программы.

Попытка отловить возвращаемое функцией WaveoutReset значения ни к чему не приводит.
( просто не выполняются строки после WaveOutreset )

У меня ощущение, что я где-то делаю очень грубую ошибку, но вот где?...

---

← →
Василий   (2006-07-11 13:37) [1]

У меня такая же проблема. Если решил, сообщи как?

С уважением.
Василий

---

← →
han_malign ©   (2006-07-11 16:42) [2]

а не надо в контексте внутреннего потока WaveOut пытаться его же остановить...
PostMessage

---

Страницы: 1 вся ветка

Текущий архив: 2007.03.11;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.041 c