Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 2002.01.08;
Скачать: [xml.tar.bz2];

Вниз

Как снять с звуковой карты, форму сигнала.   Найти похожие ветки 

 
Pasha   (2001-09-21 15:58) [0]

Как снять с звуковой карты, форму сигнала.
Для того чтобы вычислить изменения звукового сигнала во времени.


 
REL   (2001-09-25 20:04) [1]

Это достаточно просто:
Используй WinAPI
Вот программка (кто-то давным-давно уже в Inet кинул):

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem;

type
TData8 = array [0..127] of byte;
PData8 = ^TData8;
TData16 = array [0..127] of smallint;
PData16 = ^TData16;
TPointArr = array [0..127] of TPoint;
PPointArr = ^TPointArr;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
PaintBox1: TPaintBox;
TrackBar1: TTrackBar;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

var
WaveIn: hWaveIn;
hBuf: THandle;
BufHead: TWaveHdr;
bufsize: integer;
Bits16: boolean;
p: PPointArr;
stop: boolean = false;

procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
BufSize := TrackBar1.Position * 500 + 100;
Bits16 := CheckBox1.Checked;
with header do begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 22050;
wBitsPerSample := integer(Bits16) * 8 + 8;
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));
GetMem(p, BufSize * sizeof(TPoint));
stop := true;
WaveInStart(WaveIn);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if stop = false then Exit;
stop := false;
while not stop do Application.ProcessMessages;
stop := false;
WaveInReset(WaveIn);
WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
WaveInClose(WaveIn);
GlobalUnlock(hBuf);
GlobalFree(hBuf);
FreeMem(p, BufSize * sizeof(TPoint));
end;

procedure TForm1.OnWaveIn;
var
i: integer;
data8: PData8;
data16: PData16;
h: integer;
XScale, YScale: single;
begin
h := PaintBox1.Height;
XScale := PaintBox1.Width / BufSize;
if Bits16 then begin
data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);
YScale := h / (1 shl 16);
for i := 0 to BufSize - 1 do
p^[i] := Point(round(i * XScale),
round(h / 2 - data16^[i] * YScale));
end else begin
Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
YScale := h / (1 shl 8);
for i := 0 to BufSize - 1 do
p^[i] := Point(round(i * XScale),
round(h - data8^[i] * YScale));
end;
with PaintBox1.Canvas do begin
Brush.Color := clWhite;
FillRect(ClipRect);
Polyline(Slice(p^, BufSize));
end;
if stop
then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
SizeOf(TWaveHdr))
else stop := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2.Click;
end;




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

Форум: "Система";
Текущий архив: 2002.01.08;
Скачать: [xml.tar.bz2];

Наверх









Память: 0.82 MB
Время: 0.037 c
14-22408
fliz
2001-11-08 15:24
2002.01.08
это что, баг в Дельфи ?! :((


1-22061
Колеся
2001-12-18 19:44
2002.01.08
почему MDI форма не отображает MDIChild в меню ???


6-22277
prosof
2001-10-02 10:21
2002.01.08
Определение траффика каждого корреспондента сети по IP.


1-22082
Chak
2001-12-19 10:07
2002.01.08
Как правильно передать параметр функции в DLL-ке.


3-21956
Севостьянов Игорь
2001-12-05 17:56
2002.01.08
Программно выполнить SHUTDOWN IMMEDIATE





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский