Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 27.06.2017, 18:41
amam amam вне форума
Прохожий
 
Регистрация: 05.04.2017
Сообщения: 17
Версия Delphi: 7
Репутация: 10
По умолчанию Воспроизведение wav

Как с помощью фнкции waveOutWrite проиграть звук длиной 3-5 секунд? Я пробовал проиграть но проигрывается только несколько милисекунд звука а потом вылетает AV.
Ответить с цитированием
  #2  
Старый 27.06.2017, 19:44
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

PlaySound function описание на msdn есть. Можно даже 6 сек. проиграть.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 27.06.2017, 21:16
amam amam вне форума
Прохожий
 
Регистрация: 05.04.2017
Сообщения: 17
Версия Delphi: 7
Репутация: 10
По умолчанию

Пробовал и PlaySound. Та вобще ничего не проигрывает. Звук у меня хранится в структуре TWaveHdr
Ответить с цитированием
  #4  
Старый 28.06.2017, 06:04
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Вот так по-примеру из drkb долго играет, проверил, но есть койчего лишнего, можно будет и убрать
Код:
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, MMSystem;

const
 WM_FINISHED = WM_USER + $200;

type

TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);

   private
   fData: PChar;
   fWaveHdr: PWAVEHDR;
   fWaveOutHandle: HWAVEOUT;

   procedure ReversePlay(const szFileName: string);
   procedure WaveOutProc(hwo: HWAVEOUT; uMsg: UINT; dwParam1,
     dwParam2: DWORD);
   procedure WmFinished(var Msg: TMessage); message WM_FINISHED;

   { Private declarations }

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure Interchange(hpchPos1, hpchPos2: PChar; wLength: Word);
var
 wPlace: word;
 bTemp: char;
begin
 for wPlace := 0 to wLength - 1 do
  begin
   bTemp := hpchPos1[wPlace];
   hpchPos1[wPlace] := hpchPos2[wPlace];
   hpchPos2[wPlace] := bTemp
  end;
end;
{
Callback function to be called during waveform-audio playback
to process messages related to the progress of t he playback.
}

procedure waveOutPrc(hwo: HWAVEOUT; uMsg: UINT; dwInstance,
dwParam1, dwParam2: DWORD); stdcall;
begin
 TForm1(dwInstance).WaveOutProc(hwo, uMsg, dwParam1, dwParam2)
end;

procedure TForm1.WaveOutProc(hwo: HWAVEOUT; uMsg: UINT; dwParam1,
dwParam2: DWORD);
begin
 case uMsg of
   WOM_OPEN:;
   WOM_CLOSE: fWaveOutHandle := 0;
   WOM_DONE:  PostMessage(Handle, WM_FINISHED, 0, 0);
 end
end;

procedure TForm1.ReversePlay(const szFileName: string);
var
 mmioHandle: HMMIO;
 mmckInfoParent: MMCKInfo;
 mmckInfoSubChunk: MMCKInfo;
 dwFmtSize, dwDataSize: DWORD;
 pFormat: PWAVEFORMATEX;
 wBlockSize: word;
begin
{ The mmioOpen function opens a file for unbuffered or buffered I/O }

mmioHandle := mmioOpen(PChar(szFileName), nil, MMIO_READ or MMIO_ALLOCBUF);
if mmioHandle = 0 then
   raise Exception.Create('Unable to open file ' + szFileName);
try
   { mmioStringToFOURCC converts a null-terminated string to a four-character code }
   mmckInfoParent.fccType := mmioStringToFOURCC('WAVE', 0);
   { The mmioDescend function descends into a chunk of a RIFF file }
   if mmioDescend(mmioHandle, @mmckinfoParent, nil, MMIO_FINDRIFF) <>
     MMSYSERR_NOERROR then raise Exception.Create(szFileName + ' is not a valid wave file');

   mmckinfoSubchunk.ckid := mmioStringToFourCC('fmt ', 0);
   if mmioDescend(mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
     MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
     raise Exception.Create(szFileName + ' is not a valid wave file');

   dwFmtSize := mmckinfoSubchunk.cksize;
   GetMem(pFormat, dwFmtSize);

   try

     { The mmioRead function reads a specified number of bytes from a file }
      if DWORD(mmioRead(mmioHandle, PChar(pFormat), dwFmtSize)) <>
       dwFmtSize then
       raise Exception.Create('Error reading wave data');

     if pFormat^.wFormatTag <> WAVE_FORMAT_PCM then
       raise Exception.Create('Invalid wave file format');

     { he waveOutOpen function opens the given waveform-audio output device for playback }
      if waveOutOpen(@fWaveOutHandle, WAVE_MAPPER, pFormat, 0, 0,
       WAVE_FORMAT_QUERY) <> MMSYSERR_NOERROR then
        raise Exception.Create('Cannot play format');
      mmioAscend(mmioHandle, @mmckinfoSubchunk, 0);
     mmckinfoSubchunk.ckid := mmioStringToFourCC('data', 0);
     if mmioDescend(mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
       MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
       raise Exception.Create('No data chunk');

     dwDataSize := mmckinfoSubchunk.cksize;
     if dwDataSize = 0 then
       raise Exception.Create('Chunk has no data');

     if waveOutOpen(@fWaveOutHandle, WAVE_MAPPER, pFormat,
       DWORD(@WaveOutPrc), Integer(Self), CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
     begin
       fWaveOutHandle := 0;
       raise Exception.Create('Failed to open output device');
     end;

     wBlockSize := pFormat^.nBlockAlign;
     ReallocMem(pFormat, 0);
     ReallocMem(fData, dwDataSize);

     if DWORD(mmioRead(mmioHandle, fData, dwDataSize)) <> dwDataSize then

       raise Exception.Create('Unable to read data chunk');
     GetMem(fWaveHdr, SizeOf(WAVEHDR));
     fWaveHdr^.lpData  := fData;
     fWaveHdr^.dwBufferLength := dwDataSize;
     fWaveHdr^.dwFlags := 0;
     fWaveHdr^.dwLoops := 0;
     fWaveHdr^.dwUser := 0;

     { The waveOutPrepareHeader function prepares a waveform-audio data block for playback. }

     if waveOutPrepareHeader(fWaveOutHandle, fWaveHdr,
       SizeOf(WAVEHDR)) <> MMSYSERR_NOERROR then
       raise Exception.Create('Unable to prepare header');
     { The waveOutWrite function sends a data block to the given waveform-audio output device.}

     if waveOutWrite(fWaveOutHandle, fWaveHdr, SizeOf(WAVEHDR)) <>
       MMSYSERR_NOERROR then
       raise Exception.Create('Failed to write to device');

   finally
     ReallocMem(pFormat, 0)
   end
finally
   mmioClose(mmioHandle, 0)
end
end;

// Play a wave file
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled := False;
try
   ReversePlay('C:\TestSong.wav')
except
   Button1.Enabled := True;
   raise
end
end;

// Stop Playback
procedure TForm1.Button2Click(Sender: TObject);
begin
{ The waveOutReset function stops playback on the given waveform-audio output device }
WaveOutReset(fWaveOutHandle);
end;

procedure TForm1.WmFinished(var Msg: TMessage);
begin
 WaveOutUnprepareHeader(fWaveOutHandle, fWaveHdr, SizeOf(WAVEHDR));
 WaveOutClose(fWaveOutHandle);
 ReallocMem(fData, 0);
 ReallocMem(fWaveHdr, 0);
 Button1.Enabled := True;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 WaveOutReset(fWaveOutHandle);
 while fWaveOutHandle <> 0 do Application.ProcessMessages
end;

end.
Ответить с цитированием
  #5  
Старый 28.06.2017, 07:27
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

PlaySound работает отлично. Только что проверил.

Код:
uses
  MMSystem;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PlaySound('c:\Windows\Media\Ring08.wav', 0, SND_ASYNC);   
end;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #6  
Старый 28.06.2017, 12:10
amam amam вне форума
Прохожий
 
Регистрация: 05.04.2017
Сообщения: 17
Версия Delphi: 7
Репутация: 10
По умолчанию

а если у меня wav в TmemoryStream?
Ответить с цитированием
  #7  
Старый 28.06.2017, 12:12
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

А как он в TMemoryStream оказался?
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #8  
Старый 28.06.2017, 12:13
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

А раньше в TWaveHdr лежал и играл через waveOutWrite можете описать что хоть нужно, звуки и из ресурсов ещё проигрывать можно
Ответить с цитированием
  #9  
Старый 28.06.2017, 12:17
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию 100% рабочий код

Цитата:
Сообщение от amam
а если у меня wav в TmemoryStream?
Ну и что?

Код:
var
  ms: TMemoryStream;
begin
  ms:=TMemoryStream.Create;
  try
    ms.LoadFromFile('c:\Windows\Media\Ring08.wav');
    ms.Position:=0;
    PlaySound(
      ms.Memory,
      0,
      SND_MEMORY //or SND_ASYNC
    );
  finally
    ms.Free;
  end;
end;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #10  
Старый 28.06.2017, 12:45
amam amam вне форума
Прохожий
 
Регистрация: 05.04.2017
Сообщения: 17
Версия Delphi: 7
Репутация: 10
По умолчанию

Я со стороны сервера записываю звук в TmemoryStream.
Код:
    sobuf.Write(WaveHdrIn.lpData[0],WaveHdrIn.dwBytesRecorded);
    waveInAddBuffer(wavein,@WaveHdrIn,sizeof(TwaveHdr));
После передаю данный звук на клиет для последующего воспроизведения. Пробую так:
Код:
var
  buf:array[0..4000]of byte;
  a:integer;
begin
    a:=Socket.ReceiveBuf(buf,sizeof(buf));
    receivesou.Write(buf[0],a);
    if receivesou.size>=sizesou then
    begin
        receivesou.Position:=0;
        playsound(receivesou.Memory, 0, SND_MEMORY or SND_ASYNC);
    end;
end;
Вот так не пашет. Звук просто не играет.

Есть еще такой вариант:
Код:
var
  buf:array[0..4000]of byte;
  a:integer;
begin
    a:=Socket.ReceiveBuf(buf,sizeof(buf));
    receivesou.Write(buf[0],a);
    if receivesou.size>=sizesou then
    begin
        receivesou.Position:=0;
        With WaveHdrOut do
        begin
          dwFlags:= WHDR_INQUEUE;
          dwBufferLength:= receivesou.size;
          dwBytesRecorded:= 0;
          dwUser:= 0;
          dwLoops:= 1;
          GetMem(WaveHdrOut.lpData, receivesou.size);
        end;
        receivesou.Read(WaveHdrOut.lpData^,receivesou.size);
        waveplay(@WaveHdrOut);
    end;
end;

procedure TForm1.waveplay(mb: pointer);
begin
    waveOutPrepareHeader(WaveOut,mb,sizeof(WaveHdrOut));
    waveOutWrite(WaveOut,mb,sizeof(WaveHdrOut));
end;

Так воспроизводится не весь звук, а только несколько милисекунд. И потом вылетает AV
Ответить с цитированием
  #11  
Старый 29.06.2017, 09:57
Аватар для Verevkin
Verevkin Verevkin вне форума
Прохожий
 
Регистрация: 22.06.2015
Адрес: 1600, пенсильвания-авеню, п.г.т. верхний Вашингтонск, 8126 км от МКАД, от поста ГАИ - налево.
Сообщения: 40
Версия Delphi: 3...XE10
Репутация: -50
По умолчанию

У меня из ресурса проигрывается даже mp3. Правда, с модифицированным хедером, но факт. Всё внутри exe и не выгружается на диск для воспроизведения. Вот демо (делал пару лет назад для одного товарища)
Могу поискать исходники.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 13:46.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter