Форум по 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 долго играет, проверил, но есть койчего лишнего, можно будет и убрать
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
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 работает отлично. Только что проверил.

Код:
1
2
3
4
5
6
7
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?
Ну и что?

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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.
Код:
1
2
sobuf.Write(WaveHdrIn.lpData[0],WaveHdrIn.dwBytesRecorded);
waveInAddBuffer(wavein,@WaveHdrIn,sizeof(TwaveHdr));
После передаю данный звук на клиет для последующего воспроизведения. Пробую так:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
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;
Вот так не пашет. Звук просто не играет.

Есть еще такой вариант:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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
Сообщения: 45
Версия Delphi: 3...XE12
Репутация: -50
По умолчанию

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


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

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