Смекни!
smekni.com

Обзор элементов языка программирования (стр. 5 из 5)

WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),SizeOf(TWaveHdr));

data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);

//перепишем звук из массива в который пишется

//в массив который обрабатывается чтоб запись его не портила

move(data16^[0],m,BufSize*2);

if data16^[0]<>m[1] then showMessage('Неуспела');

//Обработказвука

s:=0;

s0:=0;

max:=0;

for i := 1 to BufSize do begin

z:=m[i];

inc(s0,z);

z:=abs(z);

inc(s,z);

if z>max then max:=z;

end;

//показзвука

s:=s div bufSize;

s0:=s0 div bufSize;

label1.caption:='Среднее: '+intToStr(s)+

', Максимум: '+intToStr(max)+

', Постоянный уровень: '+intToStr(s0);

with form1.image1.Picture.Bitmap.canvas do begin

fillRect(rect(0,0,w,h));

pen.color:=$CCCCCC; moveTo(w,h2); lineTo(0,h2);

pen.color:=0;

max:=abs(max-abs(s0));

if max<16 then max:=16;

if checkBox1.checked then d:=BufSize else d:=w;

for x:=1 to w do begin

xx:=x*BufSize div d;

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

26

изм лист № докум Подпись Дата

Продолжение Приложения В

y:=h2+(m[xx]-s0)*h2 divmax;

if x=1 then moveTo(0,y) else lineTo(x,y);

end;

end;

if rec then begin

//запись в массив для файла

setLength(mz,qz+bufSize+1);

move(m[1],mz[qz+1],BufSize*2);

inc(qz,BufSize);

form1.label2.caption:='Записано '+formatFloat('0.00',qz*2/1000000)+' мб';

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

w:=image1.width;

h:=image1.height;

h2:=h div 2;

image1.Picture.Bitmap.width:=w;

image1.Picture.Bitmap.height:=h;

Form1.Button1Click(Sender);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

Form1.Button2Click(Sender)

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

winExec('SndVol22.exe /r',SW_SHOW);

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var fw:file;

begin

if rec then begin

rec:=false;

if qz>0 then begin

//вывод в файл wav

iniWav;

assignFile(fw,'sound.wav');

rewrite(fw,1);

blockWrite(fw,waveHdr,sizeOf(waveHdr));

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

27

изм лист № докум Подпись Дата

Продолжение Приложения В

blockWrite(fw,mz[1],qz*2);

closeFile(fw);

showMessage('Записано в "sound.wav"');

label2.visible:=false;

BitBtn1.caption:='Запись';

end;

end

else begin

qz:=0;

rec:=true;

label2.visible:=true;

BitBtn1.caption:='Стой';

end;

end;

end.

constBufSize=11000; { Размер буфера на 1 сек}

var

Form1: TForm1;

implementation

var

WaveIn: hWaveIn;

hBuf: THandle;

BufHead: TWaveHdr;

m:array[1..bufSize] of smallInt;

h,w,h2:integer;

zs:boolean=false;//запущен звук

//Для записи в wav

rec:boolean=false; //идет запись

mz :array of smallInt;

waveHdr:tWaveFileHdr;

qz:integer; //записано звука;

{$R *.DFM}

PROCEDUREiniWav;

begin

WaveHdr.riff:='RIFF';

WaveHdr.cWavFmt:='WAVEfmt ';

WaveHdr.dwHdrLen:=16;

WaveHdr.wFormat:=1;

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

28

изм лист № докум Подпись Дата

Продолжение Приложения В

WaveHdr.wNumChannels:=1;

WaveHdr.dwSampleRate:=11000;

WaveHdr.wBlockAlign:=4;

WaveHdr.dwBytesPerSec:=22000;

WaveHdr.wBitsPerSample:=16;

WaveHdr.cData:='data';

WaveHdr.dwDataLen:=qz*2;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

header: TWaveFormatEx;

BufLen: word;

buf: pointer;

begin

if zs then exit;

with header do begin

wFormatTag := WAVE_FORMAT_PCM;

nChannels := 1; // количество каналов

nSamplesPerSec := 11000;// частота

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));

zs:=true;

WaveInStart(WaveIn);

End;

procedure TForm1.Button2Click(Sender: TObject);

begin

if not zs then Exit;

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

29

изм лист № докум Подпись Дата

Продолжение приложения В

WaveInReset(WaveIn);

WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));

WaveInClose(WaveIn);

GlobalUnlock(hBuf);

GlobalFree(hBuf);

zs:=false;

end;

procedure TForm1.OnWaveIn;

var

data16: PData16;

i,d,z,s,x,y,xx,max,s0: integer;

begin

//сразу пустим запись дальше чтоб не прерывалась

WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),SizeOf(TWaveHdr));

data16 := PData16(PWaveHdr(Msg.lParam)^.lpData);

//перепишем звук из массива в который пишется

//в массив который обрабатывается чтоб запись его не портила

move(data16^[0],m,BufSize*2);

if data16^[0]<>m[1] then showMessage('Не успела');

//Обработка звука

s:=0;

s0:=0;

max:=0;

for i := 1 to BufSize do begin

z:=m[i];

inc(s0,z);

z:=abs(z);

inc(s,z);

if z>max then max:=z;

end;

//показ звука

s:=s div bufSize;

s0:=s0 div bufSize;

label1.caption:='Среднее: '+intToStr(s)+

', Максимум: '+intToStr(max)+

', Постоянный уровень: '+intToStr(s0);

with form1.image1.Picture.Bitmap.canvas do begin

fillRect(rect(0,0,w,h));

pen.color:=$CCCCCC; moveTo(w,h2); lineTo(0,h2);

pen.color:=0;

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

30

изм лист № докум Подпись Дата

Продолжение приложения В

max:=abs(max-abs(s0));

if max<16 then max:=16;

if checkBox1.checked then d:=BufSize else d:=w;

for x:=1 to w do begin

xx:=x*BufSize div d;

y:=h2+(m[xx]-s0)*h2 div max;

if x=1 then moveTo(0,y) else lineTo(x,y);

end;

end;

if rec then begin

//запись в массив для файла

setLength(mz,qz+bufSize+1);

move(m[1],mz[qz+1],BufSize*2);

inc(qz,BufSize);

form1.label2.caption:='Записано '+formatFloat('0.00',qz*2/1000000)+' мб';

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

w:=image1.width;

h:=image1.height;

h2:=h div 2;

image1.Picture.Bitmap.width:=w;

image1.Picture.Bitmap.height:=h;

Form1.Button1Click(Sender);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

Form1.Button2Click(Sender)

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

winExec('SndVol22.exe /r',SW_SHOW);

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var fw:file;

begin

if rec then begin

rec:=false;

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

31

изм лист № докум Подпись Дата

Продолжение приложения В

ifqz>0 thenbegin

//вывод в файл wav

iniWav;

assignFile(fw,'sound.wav');

rewrite(fw,1);

blockWrite(fw,waveHdr,sizeOf(waveHdr));

blockWrite(fw,mz[1],qz*2);

closeFile(fw);

showMessage('Записано в "sound.wav"');

label2.visible:=false;

BitBtn1.caption:='Запись';

end;

end

else begin

qz:=0;

rec:=true;

label2.visible:=true;

BitBtn1.caption:='Стой';

end;

end;

end.

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

32

изм лист № докум Подпись Дата

Приложение Г

Блок- схема к программе speaker1

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

33

изм лист № докум Подпись Дата

Приложение Д

Блок – схема к программе speaker2

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

34

изм лист № докум Подпись Дата

Список использованных источников

1. Ахо, Альфред, В., Хопкрофт, Джон, Ульман, Джеффри, Д. Структуры данных и алгоритмы. М.: Издательский дом «Вильямс», 2001.

2. Дискретная математика для программиста / Ф. А. Новиков. – СПб.: Питер, 2002.

3. Климова Л. М. Pascal 7.0. Практическое программирование. Решение типовых задач. – М.: КУДИЦ – ОБРАЗ, 2000.

4. Н. Культин TurboPascal 7.0 – СПб: БХВ – Санкт – Петербург, 1998..

5. Немлюгин С. А. TurboPascal^ практикум. – СПб.: Питер, 2002.

6. Программирование на языке Паскаль: задачник / под ред. Усковой О.Ф. – СПб.: Питер, 2003.

7. Фаронов В. В. Турбо Паскаль 7.0 – Москва, Издательство «Нолидж», 2001

8. Тессел Д. Стиль, разработка, эффективность, отладка и испытание программ. – М.: Мир, 1981

9. Докунина Т. К. Программирование и алгоритмические языки.

10. Васикова Н. Д., Тюляева В. В. Практикум по основам

программирования. Язык Паскаль., 1991.

Выполнил Муханов А. 05.12.09. КР 3706002 000009 ПЗ лист Проверила Енсепова Г.К. 07.12.09.

35

изм лист № докум Подпись Дата Выполнила Выполнила лист Проверила изм лист № докум Подпись Дата Выполнила лист Проверила изм лист № докум Подпись Дата