Советы по Delphi. Версия 1.0.6 - [5]

 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 div 8)*(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);