Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Форум программистов и сисадминов Киберфорум > Форум программистов > Delphi > Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Социальные группы Поиск Сообщения за день Заказать работу  
 
Рейтинг 4.96/25: Рейтинг темы: голосов - 25, средняя оценка - 4.96
0 / 0 / 1
Регистрация: 14.11.2012
Сообщений: 271
1

Работа с внешними устройствами

07.09.2013, 00:06. Показов 4469. Ответов 9
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Здравствуйте. Подскажите, пожалуйста, самый легкий на ваш взгляд пример, иллюстрирующий работу программы с данными (в основном это будет НЧ сигналы), поступающими на вход обычной аудиокарты. То есть я хочу разобраться как происходит процесс снятия информации с внешнего устройства и последующая работа с этой информацией в делфи. Заранее спасибо.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 07.09.2013, 00:06
Ответы с готовыми решениями:

Работа с внешними устройствами в Delphi
Помогите решить проблему:Раньше стояла XP а теперь 7,в ХР был удобный мастер работы со сканером или...

Работа с внешними файлами
У меня не выходит заполнить с файла таблицу( на рисунках там второй пункт). Вводит только одну...

работа с внешними файлами
Нужна программа Разработайте программу записи во внешний файл нескольких случайных целых чисел....

Работа с USB устройствами
Возник вопрос с обнаружением съёмных накопителей (usb-flash), с последующим копированием на них...

9
пофигист широкого профиля
4732 / 3167 / 858
Регистрация: 15.07.2013
Сообщений: 18,248
07.09.2013, 00:39 2
Цитата Сообщение от Turgenev Посмотреть сообщение
То есть я хочу разобраться как происходит процесс снятия информации с внешнего устройства и последующая работа с этой информацией в делфи.
В стандартной поставке Дельфи нет ничего, что позволяло бы получить нестандартную информацию с входа аудиокарты. Так что вам нужно?
1
Пишу на Delphi...иногда
1423 / 1278 / 286
Регистрация: 03.12.2012
Сообщений: 3,914
Записей в блоге: 5
07.09.2013, 00:55 3
Цитата Сообщение от Turgenev Посмотреть сообщение
с данными (в основном это будет НЧ сигналы), поступающими на вход обычной аудиокарты
Waveform Audio Win32 API
Цитата Сообщение от Turgenev Посмотреть сообщение
последующая работа с этой информацией в делфи
ЦОС
библиотека для БПФ - fftw

В общих чертах - чего в итоге хочется?

Добавлено через 4 минуты
Цитата Сообщение от Turgenev Посмотреть сообщение
пример
Программа для анализа спектра речевого сигнала. Часть 1-я.
Программа для анализа спектра речевого сигнала. Часть 2-я
1
10231 / 6609 / 498
Регистрация: 28.12.2010
Сообщений: 21,156
Записей в блоге: 1
07.09.2013, 10:56 4
- Быстрое преобразование Фурье. Практика использования. Часть 1 и 2.
обертка на основе

- Описание API вызова библиотеки FFTR.DLL

как происходит процесс снятия информации с внешнего устройства и последующая работа с этой информацией
Delphi
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

uses mmsytem;
 
type
    TData16 = array [0..255] of smallint;
    PData16 = ^TData16;
 
var
    WaveIn: hWaveIn;
    BufHead: TWaveHdr;
    header: TWaveFormatEx;
    BufLen: word;
    buf:    pointer;
    stop,
    Bits16: boolean;
    hBuf  : THandle;
    data16: PData16;
 
    fftio:function(var buf: array of single;
                   nf: integer;
                   directfft: Boolean
                   ): pansichar; stdcall; LibHandle: THandle;
 
 
function LinkProc(h: thandle; ProcName: string):Pointer;
begin
 result:= GetProcAddress(h, PChar(ProcName))
end;
 
// init/deinit аудиозахват
procedure wcard;
begin
 stop:= not stop;
 
 if (stop) then begin
  with header do begin
   wFormatTag := WAVE_FORMAT_PCM;
   nChannels := 1;
   nSamplesPerSec := 44100;
   wBitsPerSample := 16 ;
   nBlockAlign := nChannels * (wBitsPerSample div 8);
   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   cbSize := 0;
  end;
  WaveInOpen(Addr(WaveIn),
             WAVE_MAPPER,
             addr(header),
             form1.Handle,
             0,
             CALLBACK_WINDOW);
  BufLen := header.nBlockAlign * BufSize;
  hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  Buf := GlobalLock(hBuf);
  with BufHead do begin
   lpData := Buf;
   dwBufferLength := BufLen;
   dwFlags := WHDR_BEGINLOOP;
  end;
  WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
  WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
  WaveInStart(WaveIn);
 end else begin
  WaveInReset(WaveIn);
  WaveInUnPrepareHeader(WaveIn,
                        addr(BufHead),
                        sizeof(BufHead));
  WaveInClose(WaveIn);
  GlobalUnlock(hBuf);
  GlobalFree(hBuf)
 end
end;
 
 
procedure TForm1.OnWaveIn;
var i, a: integer;
    d: double;
begin
 if stop then begin
  // подчищаем
  GraphM1.minyValue:= -1;
  GraphM1.MaxYValue := 300;
  GraphM1.MinYValue := -150;
  GraphM1.Curves[0].ClearPoints;
  GraphM1.Curves[1].ClearPoints;
  GraphM1.Curves[2].ClearPoints;
  GraphM1.Curves[0].ColorGraph:= rgb(255, 0, 0);
  GraphM1.Curves[1].ColorGraph:= rgb(0, 255, 0);
  GraphM1.Curves[2].ColorGraph:= rgb(0, 0, 255);
 
  setlength(fDataBuf, 0);
  setlength(fDataOutBuf, 0);
 
  // выдергиваем данные
  Data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
  for i := 0 to BufSize - 1 do begin
   setlength(fDataBuf, length(fDataBuf)+1);
   fDataBuf[length(fDataBuf)-1]:= Data16^[i];
 
   // отрисовываем осциллограмму прямого захвата со смещением = 200
   if ch1.Checked then
    GraphM1.Curves[1].AddPoint(i, Data16^[i] + 200);
  end;
 
  // прямое БПФ
  fftio(fDataBuf, 1024, true);
 
  // отрисовываем спектр
  if ch3.Checked then
   for i:= 0 to BufSize div 2 -1 do begin
    d:= 20*log10(abs(fDataBuf[i]) + 0.000001) {-25}; // -25дб это подставка, чтоб убрать фоновые шумы
    GraphM1.Curves[0].AddPoint(i * header.nSamplesPerSec {44100}*header.nChannels / (2*BufSize),
                               d);
   end;
 
  // обратное БПФ
  fDataOutBuf:= fDataBuf;
  fftio(fDataOutBuf, 1024, false);
  // отрисовываем осциллограмму после прямого и обратного БПФ со смещением = 100
  // это и будут восстановленные данные
  if ch2.Checked then
   for i:= 0 to length(fDataOutBuf) -1 do
    GraphM1.Curves[2].AddPoint(i, fDataOutBuf[i] + 100);
 
  // набиваем буфер
  WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
 end
end;
 
 
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 wcard;
 GraphM1.Free;
 if LibHandle<>0 then closehandle(fftio)
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 DoubleBuffered  := true;
 decimalseparator:= '.';
 
 GraphM1:= TGraphM.Create(nil);
 // добавляем три серии для визуализации
 GraphM1.Curves.Add;
 GraphM1.Curves.Add;
 GraphM1.Curves.Add;
 // настройки отображения
 GraphM1.Parent:= form1;
 GraphM1.Align:= alclient;
 GraphM1.Navigator:= true;
 GraphM1.DoubleBuffered:= true;
 
 // подключаем DLL
 LibHandle:= LoadLibrary('FFTR.dll');
 if LibHandle<>0 then
  fftio:= LinkProc(LibHandle, 'fftio');
 
 wcard
end;
Литература по ЦОС и алгоритмам
1
0 / 0 / 1
Регистрация: 14.11.2012
Сообщений: 271
07.09.2013, 23:53  [ТС] 5
сколько инфы, всем спасибо! можно ли, пожалуйста, полноценный делфи проект без всяких добавок этого кода:
Delphi
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

uses mmsytem;
 
type
    TData16 = array [0..255] of smallint;
    PData16 = ^TData16;
 
var
    WaveIn: hWaveIn;
    BufHead: TWaveHdr;
    header: TWaveFormatEx;
    BufLen: word;
    buf:    pointer;
    stop,
    Bits16: boolean;
    hBuf  : THandle;
    data16: PData16;
 
    fftio:function(var buf: array of single;
                   nf: integer;
                   directfft: Boolean
                   ): pansichar; stdcall; LibHandle: THandle;
 
 
function LinkProc(h: thandle; ProcName: string):Pointer;
begin
 result:= GetProcAddress(h, PChar(ProcName))
end;
 
// init/deinit аудиозахват
procedure wcard;
begin
 stop:= not stop;
 
 if (stop) then begin
  with header do begin
   wFormatTag := WAVE_FORMAT_PCM;
   nChannels := 1;
   nSamplesPerSec := 44100;
   wBitsPerSample := 16 ;
   nBlockAlign := nChannels * (wBitsPerSample div 8);
   nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   cbSize := 0;
  end;
  WaveInOpen(Addr(WaveIn),
             WAVE_MAPPER,
             addr(header),
             form1.Handle,
             0,
             CALLBACK_WINDOW);
  BufLen := header.nBlockAlign * BufSize;
  hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  Buf := GlobalLock(hBuf);
  with BufHead do begin
   lpData := Buf;
   dwBufferLength := BufLen;
   dwFlags := WHDR_BEGINLOOP;
  end;
  WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
  WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
  WaveInStart(WaveIn);
 end else begin
  WaveInReset(WaveIn);
  WaveInUnPrepareHeader(WaveIn,
                        addr(BufHead),
                        sizeof(BufHead));
  WaveInClose(WaveIn);
  GlobalUnlock(hBuf);
  GlobalFree(hBuf)
 end
end;
 
 
procedure TForm1.OnWaveIn;
var i, a: integer;
    d: double;
begin
 if stop then begin
  // подчищаем
  GraphM1.minyValue:= -1;
  GraphM1.MaxYValue := 300;
  GraphM1.MinYValue := -150;
  GraphM1.Curves[0].ClearPoints;
  GraphM1.Curves[1].ClearPoints;
  GraphM1.Curves[2].ClearPoints;
  GraphM1.Curves[0].ColorGraph:= rgb(255, 0, 0);
  GraphM1.Curves[1].ColorGraph:= rgb(0, 255, 0);
  GraphM1.Curves[2].ColorGraph:= rgb(0, 0, 255);
 
  setlength(fDataBuf, 0);
  setlength(fDataOutBuf, 0);
 
  // выдергиваем данные
  Data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
  for i := 0 to BufSize - 1 do begin
   setlength(fDataBuf, length(fDataBuf)+1);
   fDataBuf[length(fDataBuf)-1]:= Data16^[i];
 
   // отрисовываем осциллограмму прямого захвата со смещением = 200
   if ch1.Checked then
    GraphM1.Curves[1].AddPoint(i, Data16^[i] + 200);
  end;
 
  // прямое БПФ
  fftio(fDataBuf, 1024, true);
 
  // отрисовываем спектр
  if ch3.Checked then
   for i:= 0 to BufSize div 2 -1 do begin
    d:= 20*log10(abs(fDataBuf[i]) + 0.000001) {-25}; // -25дб это подставка, чтоб убрать фоновые шумы
    GraphM1.Curves[0].AddPoint(i * header.nSamplesPerSec {44100}*header.nChannels / (2*BufSize),
                               d);
   end;
 
  // обратное БПФ
  fDataOutBuf:= fDataBuf;
  fftio(fDataOutBuf, 1024, false);
  // отрисовываем осциллограмму после прямого и обратного БПФ со смещением = 100
  // это и будут восстановленные данные
  if ch2.Checked then
   for i:= 0 to length(fDataOutBuf) -1 do
    GraphM1.Curves[2].AddPoint(i, fDataOutBuf[i] + 100);
 
  // набиваем буфер
  WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam), SizeOf(TWaveHdr))
 end
end;
 
 
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 wcard;
 GraphM1.Free;
 if LibHandle<>0 then closehandle(fftio)
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 DoubleBuffered  := true;
 decimalseparator:= '.';
 
 GraphM1:= TGraphM.Create(nil);
 // добавляем три серии для визуализации
 GraphM1.Curves.Add;
 GraphM1.Curves.Add;
 GraphM1.Curves.Add;
 // настройки отображения
 GraphM1.Parent:= form1;
 GraphM1.Align:= alclient;
 GraphM1.Navigator:= true;
 GraphM1.DoubleBuffered:= true;
 
 // подключаем DLL
 LibHandle:= LoadLibrary('FFTR.dll');
 if LibHandle<>0 then
  fftio:= LinkProc(LibHandle, 'fftio');
 
 wcard
end;
0
Пишу на Delphi...иногда
1423 / 1278 / 286
Регистрация: 03.12.2012
Сообщений: 3,914
Записей в блоге: 5
08.09.2013, 00:01 6
Цитата Сообщение от Turgenev Посмотреть сообщение
полноценный делфи проект без всяких добавок этого кода
ссылки есть в #2
Цитата Сообщение от cotseec Посмотреть сообщение
Программа для анализа спектра речевого сигнала. Часть 1-я.
Программа для анализа спектра речевого сигнала. Часть 2-я
(там и исходники есть) или интересует без использования mmsystem? в таком случае еще вариант с использованием bass.dll (некоторую предварительную обработку можно осуществить с помощью этой библиотеки, но не зная конечной цели ....)
1
0 / 0 / 1
Регистрация: 14.11.2012
Сообщений: 271
08.09.2013, 17:09  [ТС] 7
Цитата Сообщение от cotseec Посмотреть сообщение
ссылки есть в #2 (там и исходники есть) или интересует без использования mmsystem? в таком случае еще вариант с использованием bass.dll (некоторую предварительную обработку можно осуществить с помощью этой библиотеки, но не зная конечной цели ....)
Спасибо, не сразу увидел. Интересует пока только понимание процесса оцифровки сигнала и вывода его в программу.

Ссылка на учебник http://delphiworld.narod.ru/ba... 2_api.html очень помогает разобраться, но можно ли где нибудь найти исходник приведенного там кода на делфи 7? А то самому повторить на делфи 7 знаний пока не хватает. Вот этот код:
Delphi
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

uses Windows, MMSystem;
type
  TModeDescr = record
    mode: DWORD; // код режима работы
    descr: string[32]; // словесное описание
  end;
 
const
  // массив содержит сопоставления режима работы и словесного описания
  modes: array[1..12] of TModeDescr = ((mode: WAVE_FORMAT_1M08; descr:
    '11.025 kHz, mono, 8-bit'),
    (mode: WAVE_FORMAT_1M16; descr: '11.025 kHz, mono, 16-bit'),
    (mode: WAVE_FORMAT_1S08; descr: '11.025 kHz, stereo, 8-bit'),
    (mode: WAVE_FORMAT_1S16; descr: '11.025 kHz, stereo, 16-bit'),
    (mode: WAVE_FORMAT_2M08; descr: '22.05 kHz, mono, 8-bit'),
    (mode: WAVE_FORMAT_2M16; descr: '22.05 kHz, mono, 16-bit'),
    (mode: WAVE_FORMAT_2S08; descr: '22.05 kHz, stereo, 8-bit'),
    (mode: WAVE_FORMAT_2S16; descr: '22.05 kHz, stereo, 16-bit'),
    (mode: WAVE_FORMAT_4M08; descr: '44.1 kHz, mono, 8-bit'),
    (mode: WAVE_FORMAT_4M16; descr: '44.1 kHz, mono, 16-bit'),
    (mode: WAVE_FORMAT_4S08; descr: '44.1 kHz, stereo, 8-bit'),
    (mode: WAVE_FORMAT_4S16; descr: '44.1 kHz, stereo, 16-bit'));
 
procedure ShowInfo;
var
  WaveNums, i, j: integer;
  WaveInCaps: TWaveInCaps;
    // структура в которую помещается информация об устройстве
begin
  WaveNums := waveInGetNumDevs;
  if WaveNums > 0 then // если в системе есть устройства аудиоввода,то
  begin
    for i := 0 to WaveNums - 1 do
      // получаем характеристики всех имеющихся устройств
    begin
      waveInGetDevCaps(i, @WaveInCaps, sizeof(TWaveInCaps));
      // добавляем наименование устройства
      MainForm.Memo.Lines.Add(PChar(@WaveInCaps.szPname));
      for j := 1 to High(modes) do
      begin
        // выводим поддерживаемые устройством режимы работы
        if (modes[j].mode and WaveInCaps.dwFormats) = modes[j].mode then
          Memo.Lines.Add(modes[j].descr);
      end;
    end;
  end;
end;
0
10231 / 6609 / 498
Регистрация: 28.12.2010
Сообщений: 21,156
Записей в блоге: 1
08.09.2013, 19:10 8
ли где нибудь найти исходник
еще раз, если плохо видно "Описание API вызова библиотеки FFTR.DLL".
0
0 / 0 / 1
Регистрация: 14.11.2012
Сообщений: 271
08.09.2013, 21:29  [ТС] 9
Цитата Сообщение от raxp Посмотреть сообщение
еще раз, если плохо видно "Описание API вызова библиотеки FFTR.DLL".
перезалейте, пожалуйста. Ошибку выдает постоянно
0
10231 / 6609 / 498
Регистрация: 28.12.2010
Сообщений: 21,156
Записей в блоге: 1
08.09.2013, 22:10 10
...все нормально скачивается.

На всякий случай сюда:
Вложения
Тип файла: zip fftr.zip (265.8 Кб, 65 просмотров)
1
08.09.2013, 22:10
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 08.09.2013, 22:10
Помогаю со студенческими работами здесь

Delphi 2009 - работа с внешними приложениями
Не подскажите как мне в Delphi описать функцию блокировки кнопки &quot;закрыть&quot; в нужной мне программе...

Работа с внешними приложениями PDF, DOC, RTF...
Скажите, можно ли из программы, написанной в Delphi, обращаться к внешним документам в форматах...

Работа с внешними файлами, ввод/вывод в текстовый файл
Как сделать эту лабу... Помогите пожалуйста

Delphi 2010. Работа с внешними приложениями и поиск элементов
Доброго времени суток! Дело в том,что мне необходимо написать программу, которая должна работать с...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru