Валентин Озеров - Советы по Delphi. Версия 1.0.6

unit LinearSystem;

interface

{============== Тип, описывающий формат WAV ==================}

type wavheader = record

nChannels : Word;

nBitsPerSample : LongInt;

nSamplesPerSec : LongInt;

nAvgBytesPerSec : LongInt;

RIFFSize : LongInt;

fmtSize : LongInt;

formatTag : Word;

nBlockAlign : LongInt;

DataSize : LongInt;

end;

{============== Поток данных сэмпла ========================}

const MaxN = 300; { максимальное значение величины сэмпла }

type SampleIndex = 0..MaxN+3;

type DataStream = array[SampleIndex] of Real;

var N: SampleIndex;

{============== Переменные сопровождения ======================}

type Observation = record

Name : String[40]; {Имя данного сопровождения}

yyy : DataStream; {Массив указателей на данные}

WAV : WAVHeader; {Спецификация WAV для сопровождения}

Last : SampleIndex; {Последний доступный индекс yyy}

MinO, MaxO : Real; {Диапазон значений yyy}

end;

var K0R, K1R, K2R, K3R: Observation;

K0B, K1B, K2B, K3B : Observation;

{================== Переменные имени файла ===================}

var StandardDatabase: String[80];

BaseFileName: String[80];

StandardOutput: String[80];

StandardInput: String[80];

{=============== Объявления процедур ==================}

procedure ReadWAVFile(var Ki, Kj : Observation);

procedure WriteWAVFile(var Ki, Kj : Observation);

procedure ScaleData(var Kk: Observation);

procedure InitallSignals;

procedure InitLinearSystem;

implementation

{$R *.DFM}

uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}

const MaxDataSize : LongInt = (MaxN+1)*2*2;

const MaxRIFFSize : LongInt = (MaxN+1)*2*2+36;

const StandardWAV : WAVHeader = (

nChannels : Word(2);

nBitsPerSample : LongInt(16);

nSamplesPerSec : LongInt(8000);

nAvgBytesPerSec : LongInt(32000);

RIFFSize : LongInt((MaxN+1)*2*2+36);

fmtSize : LongInt(16);

formatTag : Word(1);

nBlockAlign : LongInt(4);

DataSize : LongInt((MaxN+1)*2*2)

);

{================== Сканирование переменных сопровождения ===================}

procedure ScaleData(var Kk : Observation);

var I : SampleIndex;

begin

{Инициализация переменных сканирования}

Kk.MaxO:= Kk.yyy[0];

Kk.MinO:= Kk.yyy[0];

{Сканирование для получения максимального и минимального значения}

for I:= 1 to Kk.Last do begin

if kk.maxo < kk.yyy[i] then kk.maxo:= kk.yyy[i];

if kk.mino > kk.yyy[i] then kk.mino:= kk.yyy[i];

end;

end; { scaledata }

procedure ScaleAllData;

begin

ScaleData(K0R);

ScaleData(K0B);

ScaleData(K1R);

ScaleData(K1B);

ScaleData(K2R);

ScaleData(K2B);

ScaleData(K3R);

ScaleData(K3B);

end; {scalealldata}

{================== Считывание/запись WAV-данных ===================}

VAR InFile, OutFile: file of Byte;

type Tag = (F0, T1, M1);

type FudgeNum = record

case X:Tag of

F0 : (chrs : array[0..3] of byte);

T1 : (lint : LongInt);

M1 : (up,dn: Integer);

end;

var ChunkSize : FudgeNum;

procedure WriteChunkName(Name: String);

var i: Integer;

MM: Byte;

begin

for i:= 1 to 4 do begin

MM:= ord(Name[i]);

write(OutFile, MM);

end;

end; {WriteChunkName}

procedure WriteChunkSize(LL:Longint);

var I: integer;

begin

ChunkSize.x:=T1;

ChunkSize.lint:=LL;

ChunkSize.x:=F0;

for I:= 0 to 3 do Write(OutFile,ChunkSize.chrs[I]);

end;

procedure WriteChunkWord(WW: Word);

var I: integer;

begin

ChunkSize.x:=T1;

ChunkSize.up:=WW;

ChunkSize.x:=M1;

for I:= 0 to 1 do Write(OutFile,ChunkSize.chrs[I]);

end; {WriteChunkWord}

procedure WriteOneDataBlock(var Ki, Kj : Observation);

var I: Integer

begin

ChunkSize.x:=M1;

with Ki.WAV do begin

case nChannels of

1:

if nBitsPerSample=16 then begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}

ChunkSize.up = trunc(Ki.yyy[N]+0.5);

if N

N:= N+2;

end else begin {1..4 Помещаем в буфер одноканальный 8-битный сэмпл}

for I:=0 to 3 do ChunkSize.chrs[I]:= trunc(Ki.yyy[N+I]+0.5);

N:= N+4;

end;

2:

if nBitsPerSample=16 then begin {2 Двухканальный 16-битный сэмпл}

ChunkSize.dn:= trunc(Ki.yyy[N]+0.5);

ChunkSize.up := trunc(Kj.yyy[N]+0.5);

N:= N+1;

end else begin {4 Двухканальный 8-битный сэмпл}

ChunkSize.chrs[1]:= trunc(Ki.yyy[N]+0.5);

ChunkSize.chrs[3]:= trunc(Ki.yyy[N+1]+0.5);

ChunkSize.chrs[0]:= trunc(Kj.yyy[N]+0.5);

ChunkSize.chrs[2]:= trunc(Kj.yyy[N+1]+0.5);

N:= N+2;

end;

end; {with wav do begin..}

end; {четырехбайтовая переменная "chunksize" теперь заполнена}

ChunkSize.x:=T1;

WriteChunkSize(ChunkSize.lint);{помещаем 4 байта данных}

end; {WriteOneDataBlock}

procedure WriteWAVFile(var Ki, Kj : Observation);

var MM: Byte;

I: Integer;

OK: Boolean;

begin

{Приготовления для записи файла данных}

AssignFile(OutFile, StandardOutput); { Файл, выбранный в диалоговом окне }

ReWrite(OutFile);

With ki.wav do begin

DataSize:= nChannels*(nBitsPerSample div8)*(Ki.Last+1);

RIFFSize:= DataSize+36;

fmtSize:= 16;

end;

{Записываем ChunkName "RIFF"}

WriteChunkName('RIFF');

{Записываем ChunkSize}

WriteChunkSize(Ki.WAV.RIFFSize);

{Записываем ChunkName "WAVE"}

WriteChunkName('WAVE');

{Записываем tag "fmt_"}

WriteChunkName('fmt ');

{Записываем ChunkSize}

Ki.WAV.fmtSize:= 16; {должно быть 16-18}

WriteChunkSize(Ki.WAV.fmtSize);

{Записываем formatTag, nChannels}

WriteChunkWord(Ki.WAV.formatTag);

WriteChunkWord(Ki.WAV.nChannels);

{Записываем nSamplesPerSec}

WriteChunkSize(Ki.WAV.nSamplesPerSec);

{Записываем nAvgBytesPerSec}

WriteChunkSize(Ki.WAV.nAvgBytesPerSec);

{Записываем nBlockAlign, nBitsPerSample}

WriteChunkWord(Ki.WAV.nBlockAlign);

WriteChunkWord(Ki.WAV.nBitsPerSample);

{Записываем метку блока данных "data"}

WriteChunkName('data');

{Записываем DataSize}

WriteChunkSize(Ki.WAV.DataSize);

N:=0; {первая запись-позиция}

while N<=Ki.Last do WriteOneDataBlock(Ki,Kj);{помещаем 4 байта и увеличиваем счетчик n}

{Освобождаем буфер файла}

CloseFile(OutFile);

end; {WriteWAVFile}

procedure InitSpecs;

begin

end; { InitSpecs }

procedure InitSignals(var Kk : Observation);

var J: Integer;

begin

for J:= 0 to MaxN do Kk.yyy[J]:= 0.0;

Kk.MinO:= 0.0;

Kk.MaxO:= 0.0;

Kk.Last:= MaxN;

end; {InitSignals}

procedure InitAllSignals;

begin

InitSignals(K0R);

InitSignals(K0B);

InitSignals(K1R);

InitSignals(K1B);

InitSignals(K2R);

InitSignals(K2B);

InitSignals(K3R);

InitSignals(K3B);

end; {InitAllSignals}

var chunkname: string[4];

procedure ReadChunkName;

var I : integer;

MM : Byte;

begin

ChunkName[0]:= chr(4);

for i := 1 to 4 do begin

Read(InFile, MM);

ChunkName[I]:=chr(MM);

end;

end; {ReadChunkName}

procedure ReadChunkSize;

var I: integer;

MM : Byte;

begin

ChunkSize.x:= F0;

ChunkSize.lint := 0;

for i:= 0 to 3 do begin

Read(InFile, MM);

ChunkSize.chrs[I]:= MM;

end;

ChunkSize.x:= T1;

end; {ReadChunkSize}

procedure ReadOneDataBlock(var Ki,Kj:Observation);

var I: Integer;

begin

if n<=maxn then begin

ReadChunkSize; {получаем 4 байта данных}