Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 278

Раздел: Delphi » Мультимедийные приложения
/ вопрос открыт /

Доброго времени суток, уважаемые эксперты!


здравствуйте мне нужено доработать
нижеприложенный пример пример
чтения байтов с микрофона
к примеру у меня нет литературы
мне нужно чтобы данные
были записаны в массив типа integer
пажалуйста помогите.

Приложение:
  1.  
  2.  
  3.  
  4.  
  5. --------------------------------------------------------------------------------
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12. CD-ROM ----------|
  13.  
  14.  
  15.  
  16.  
  17.  
  18. MIDI ------------|
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. }
  40. unit Unit1;
  41.  
  42. interface
  43.  
  44. uses
  45. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  46. Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem, Buttons, CheckLst;
  47.  
  48. type
  49. TData8 = array [0..127] of byte;
  50. PData8 = ^TData8;
  51. TData16 = array [0..127] of smallint;
  52. PData16 = ^TData16;
  53. TPointArr = array [0..127] of TPoint;
  54. PPointArr = ^TPointArr;
  55. TForm1 = class(TForm)
  56. SpeedButton1: TSpeedButton;
  57. SpeedButton2: TSpeedButton;
  58. TrackBar1: TTrackBar;
  59. Image1: TImage;
  60. CheckBox1: TCheckBox;
  61. Image2: TImage;
  62. procedure FormDestroy(Sender: TObject);
  63. procedure CheckBox1Click(Sender: TObject);
  64. procedure FormCreate(Sender: TObject);
  65. procedure SpeedButton1Click(Sender: TObject);
  66. procedure SpeedButton2Click(Sender: TObject);
  67. private
  68. { Private declarations }
  69. public
  70. procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
  71. end;
  72.  
  73. var
  74. Form1: TForm1;
  75.  
  76. implementation
  77.  
  78. {$R *.DFM}
  79.  
  80. var
  81. WaveIn: hWaveIn;
  82. hBuf: THandle;
  83. BufHead: TWaveHdr;
  84. bufsize,SD: integer;
  85. Bits16: boolean;
  86. p: PPointArr;
  87. stop: boolean = false;
  88. OCHKI:STRING;
  89.  
  90. procedure TForm1.OnWaveIn;
  91. var
  92. i: integer;
  93. data8: PData8;
  94. data16: PData16;
  95. h: integer;
  96. XScale, YScale: single;
  97. begin
  98.  
  99. IMAGE2.Canvas.Brush.Style:=bsClear;
  100. IMAGE2.Canvas.Font.Size:=12;
  101. IMAGE2.Canvas.Font.Name:='MSSANSSERIF';
  102. SetTextColor(IMAGE2.canvas.handle, rgb(255, 0, 0));
  103. SetBKmode(IMAGE2.canvas.handle, transparent);
  104.  
  105.  
  106. h := IMAGE1.Height;
  107. XScale := IMAGE1.Width / BufSize;
  108. if Bits16 then
  109. begin
  110. data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
  111. YScale := h / (1 shl 16);
  112. for i := 0 to BufSize - 1 do
  113. p^[i] := Point(round(i * XScale),
  114. round(h / 2 - data16^[i] * YScale));
  115.  
  116. OCHKI:=INTTOSTR(data16^[i]);
  117.  
  118.  
  119. end
  120. else
  121. begin
  122. Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
  123. YScale := h / (1 shl 8);
  124. for i := 0 to BufSize - 1 do
  125. p^[i] := Point(round(i * XScale),
  126. round(h - data8^[i] * YScale));
  127.  
  128. OCHKI:=INTTOSTR(data8^[i]);
  129.  
  130.  
  131. end;
  132.  
  133. with IMAGE1.Canvas do
  134. begin
  135. Brush.Color := clWhite;
  136. FillRect(ClipRect);
  137. Polyline(Slice(p^, BufSize));
  138.  
  139. end; {}
  140.  
  141.  
  142. if stop then
  143. WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
  144. else
  145. stop := true;
  146. end;
  147.  
  148. procedure TForm1.FormDestroy(Sender: TObject);
  149. begin
  150. // Button2.Click;
  151. end;
  152.  
  153. procedure TForm1.CheckBox1Click(Sender: TObject);
  154. begin
  155. if stop then
  156. begin
  157. // Button2.Click;
  158. // Button1.Click;
  159. end;
  160. end;
  161.  
  162. procedure TForm1.FormCreate(Sender: TObject);
  163. begin
  164. TrackBar1.OnChange := CheckBox1Click;
  165. SPEEDButton1.Caption := 'Start';
  166. SPEEDButton2.Caption := 'Stop';
  167. CheckBox1.Caption := '16 / 8 bit';
  168. end;
  169.  
  170. procedure TForm1.SpeedButton1Click(Sender: TObject);
  171. var
  172. header: TWaveFormatEx;
  173. BufLen: word;
  174. buf: pointer;
  175. begin
  176.  
  177. Bits16 := CheckBox1.Checked;
  178. with header do
  179. begin
  180. wFormatTag := WAVE_FORMAT_PCM;
  181.  
  182.  
  183.  
  184. nBlockAlign := nChannels * (wBitsPerSample div 8);
  185. nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  186. cbSize := 0;
  187. end;
  188. WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
  189. Form1.Handle, 0, CALLBACK_WINDOW);
  190. BufLen := header.nBlockAlign * BufSize;
  191. hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  192. Buf := GlobalLock(hBuf);
  193. with BufHead do
  194. begin
  195. lpData := Buf;
  196. dwBufferLength := BufLen;
  197. dwFlags := WHDR_BEGINLOOP;
  198. end;
  199. WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
  200. WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
  201. GetMem(p, BufSize * sizeof(TPoint));
  202. stop := true;
  203. WaveInStart(WaveIn);
  204.  
  205. end;
  206.  
  207. procedure TForm1.SpeedButton2Click(Sender: TObject);
  208.  
  209. begin
  210. if stop = false then
  211. Exit;
  212. stop := false;
  213. while not stop do
  214. Application.ProcessMessages;
  215. stop := false;
  216. WaveInReset(WaveIn);
  217. WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
  218. WaveInClose(WaveIn);
  219. GlobalUnlock(hBuf);
  220. GlobalFree(hBuf);
  221. FreeMem(p, BufSize * sizeof(TPoint));
  222.  
  223. end;
  224.  
  225. end.
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  


Дмитрий-1648 Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Дмитрий-1648 (статус: Посетитель)
Вопрос отправлен: 21 января 2008, 21:13
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, ДМИТРИЙ!
Вот здесь http://www.torry.net/vcl/mmedia/audio/acmcomponents16.zip можно скачать абсолюно бесплатно набор компонент, которые вам точно помогут. один с компонентов, входящих в набор, умеет принимать звук с разных устройств ввода и генерирует событие, когда внутренний буфер, являющийся массивом целых чисел, заполняеться. А с ним можно делать, всё что хотите. Примеры естественно прилагаются (передача звука по сети:))

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 22 января 2008, 09:39


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:49
Выполнено за 0.03 сек.