I hope you find it useful.
unit
LinearSystem;
interface
{============== Type describing the format WAV ==================}
type
WAVHeader = record
nChannels: Word;
nBitsPerSample: LongInt;
nSamplesPerSec: LongInt;
nAvgBytesPerSec: LongInt;
RIFFSize: LongInt;
fmtSize: LongInt;
formatTag: Word;
nBlockAlign: LongInt;
DataSize: LongInt;
end;
{============== The flow of data sample
========================}
const
MaxN =
300; { the maximum value of the sample }
type
SampleIndex = 0..MaxN + 3;
type
DataStream = array[SampleIndex] of Real;
var
N:
SampleIndex;
{============== variables support
======================}
type
Observation = record
Name: string[40];
{Имя данного
сопровождения}
yyy:
DataStream; {array of pointers to the data}
WAV:
WAVHeader; {Specification WAV to accompany}
Last:
SampleIndex; {last available index yyy}
MinO,
MaxO: Real; {Range 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;
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)
);
{================== Scan tracking variables
===================}
procedure ScaleData(var Kk: Observation);
var
I:
SampleIndex;
begin
{Initialize variables scan}
Kk.MaxO
:= Kk.yyy[0];
Kk.MinO
:= Kk.yyy[0];
{Scan to get the maximum and minimum value}
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}
{================== Read / write WAV-data ===================}
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
ChunkSize.up := trunc(Ki.yyy[N] + 0.5);
if N
< MaxN then
ChunkSize.dn := trunc(Ki.yyy[N + 1] + 0.5);
N := N + 2;
end
else
begin
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
ChunkSize.dn := trunc(Ki.yyy[N] + 0.5);
ChunkSize.up := trunc(Kj.yyy[N] + 0.5);
N := N + 1;
end
else
begin
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.x := T1;
WriteChunkSize(ChunkSize.lint);
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;
WriteChunkName('RIFF');
WriteChunkSize(Ki.WAV.RIFFSize);
WriteChunkName('WAVE');
WriteChunkName('fmt ');
Ki.WAV.fmtSize := 16; {должно быть 16-18}
WriteChunkSize(Ki.WAV.fmtSize);
WriteChunkWord(Ki.WAV.formatTag);
WriteChunkWord(Ki.WAV.nChannels);
WriteChunkSize(Ki.WAV.nSamplesPerSec);
WriteChunkSize(Ki.WAV.nAvgBytesPerSec);
WriteChunkWord(Ki.WAV.nBlockAlign);
WriteChunkWord(Ki.WAV.nBitsPerSample);
WriteChunkName('data');
WriteChunkSize(Ki.WAV.DataSize);
N :=
0;
while N <= Ki.Last do
WriteOneDataBlock(Ki, Kj);
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;
ChunkSize.x := M1;
with
Ki.WAV do
case
nChannels of
1: if nBitsPerSample = 16 then
begin
Ki.yyy[N] := 1.0 *
ChunkSize.up;
if N < MaxN then
Ki.yyy[N + 1]
:= 1.0 *
ChunkSize.dn;
N := N + 2;
end
else
begin
for I := 0 to
3 do
Ki.yyy[N + I] := 1.0 *
ChunkSize.chrs[I];
N := N + 4;
end;
2: if nBitsPerSample = 16 then
begin
Ki.yyy[N] := 1.0 *
ChunkSize.dn;
Kj.yyy[N] := 1.0 *
ChunkSize.up;
N := N + 1;
end
else
begin
Ki.yyy[N] := 1.0 *
ChunkSize.chrs[1];
Ki.yyy[N + 1]
:= 1.0 *
ChunkSize.chrs[3];
Kj.yyy[N] := 1.0 *
ChunkSize.chrs[0];
Kj.yyy[N + 1]
:= 1.0 *
ChunkSize.chrs[2];
N := N + 2;
end;
end;
if N
<= MaxN then
begin {LastN := N;}
Ki.Last := N;
if
Ki.WAV.nChannels = 2
then
Kj.Last := N;
end
else
begin {LastN := MaxN;}
Ki.Last := MaxN;
if
Ki.WAV.nChannels = 2
then
Kj.Last := MaxN;
end;
end;
end;
{ReadOneDataBlock}
procedure ReadWAVFile(var Ki, Kj: Observation);
var
MM:
Byte;
I:
Integer;
OK:
Boolean;
NoDataYet: Boolean;
DataYet:
Boolean;
nDataBytes: LongInt;
begin
if
FileExists(StandardInput) then
with
Ki.WAV do
begin
OK
:= True;
AssignFile(InFile, StandardInput);
Reset(InFile);
ReadChunkName;
if
ChunkName <> 'RIFF' then
OK := False;
ReadChunkSize;
RIFFSize := ChunkSize.lint; {should be 18,678}
ReadChunkName;
if
ChunkName <> 'WAVE' then
OK := False;
ReadChunkName;
if
ChunkName <> 'fmt
' then
OK := False;
ReadChunkSize;
fmtSize := ChunkSize.lint;
ReadChunkSize;
ChunkSize.x := M1;
formatTag := ChunkSize.up;
nChannels := ChunkSize.dn;
ReadChunkSize;
nSamplesPerSec := ChunkSize.lint;
ReadChunkSize;
nAvgBytesPerSec := ChunkSize.lint;
ChunkSize.x := F0;
ChunkSize.lint := 0;
for
I := 0 to 3
do
begin
Read(InFile, MM);
ChunkSize.chrs[I] := MM;
end;
ChunkSize.x := M1;
nBlockAlign := ChunkSize.up;
nBitsPerSample := ChunkSize.dn;
for
I := 17 to fmtSize do
Read(InFile, MM);
NoDataYet := True;
while NoDataYet do
begin
ReadChunkName;
ReadChunkSize;
DataSize := ChunkSize.lint;
if
ChunkName <> 'data' then
begin
for
I := 1 to DataSize do
Read(InFile, MM);
end
else
NoDataYet := False;
end;
nDataBytes := DataSize;
if
nDataBytes > 0
then
DataYet := True;
N
:= 0;
while DataYet do
begin
ReadOneDataBlock(Ki, Kj);
nDataBytes := nDataBytes - 4;
if
nDataBytes <= 4
then
DataYet := False;
end;
ScaleData(Ki);
if
Ki.WAV.nChannels = 2
then
begin
Kj.WAV := Ki.WAV;
ScaleData(Kj);
end;
CloseFile(InFile);
end
else
begin
InitSpecs;
InitSignals(Ki);
InitSignals(Kj);
end;
end;
{ ReadWAVFile
}
{=================Operations with the data set ====================}
const
MaxNumberOfDataBaseItems = 360;
type
SignalDirectoryIndex = 0..MaxNumberOfDataBaseItems;
var
DataBaseFile: file of Observation;
LastDataBaseItem: LongInt;
ItemNameS: array[SignalDirectoryIndex] of string[40];
procedure GetDatabaseItem(Kk: Observation; N: LongInt);
begin
if N
<= LastDataBaseItem then
begin
Seek(DataBaseFile, N);
Read(DataBaseFile, Kk);
end
else
InitSignals(Kk);
end;
{GetDatabaseItem}
procedure PutDatabaseItem(Kk: Observation; N: LongInt);
begin
if N
< MaxNumberOfDataBaseItems then
if N
<= LastDataBaseItem then
begin
Seek(DataBaseFile, N);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem + 1;
end
else
while LastDataBaseItem <= N do
begin
Seek(DataBaseFile, LastDataBaseItem);
Write(DataBaseFile, Kk);
LastDataBaseItem := LastDataBaseItem + 1;
end
else
ReportError(1);
end;
{PutDatabaseItem}
procedure InitDataBase;
begin
LastDataBaseItem := 0;
if
FileExists(StandardDataBase) then
begin
Assign(DataBaseFile, StandardDataBase);
Reset(DataBaseFile);
while not
EOF(DataBaseFile) do
begin
GetDataBaseItem(K0R, LastDataBaseItem);
ItemNameS[LastDataBaseItem] := K0R.Name;
LastDataBaseItem := LastDataBaseItem + 1;
end;
if
EOF(DataBaseFile) then
if
LastDataBaseItem > 0
then
LastDataBaseItem := LastDataBaseItem - 1;
end;
end;
{InitDataBase}
function FindDataBaseName(Nstg: string): LongInt;
var
ThisOne:
LongInt;
begin
ThisOne
:= 0;
FindDataBaseName := -1;
while ThisOne < LastDataBaseItem do
begin
if
Nstg = ItemNameS[ThisOne] then
begin
FindDataBaseName := ThisOne;
Exit;
end;
ThisOne := ThisOne + 1;
end;
end;
{FindDataBaseName}
{======================= module Initialization ========================}
procedure InitLinearSystem;
begin
BaseFileName := '\PROGRA~1\SIGNAL~1\';
StandardOutput := BaseFileName + 'K0.wav';
StandardInput := BaseFileName + 'K0.wav';
StandardDataBase := BaseFileName + 'Radar.sdb';
InitAllSignals;
InitDataBase;
ReadWAVFile(K0R, K0B);
ScaleAllData;
end;
{InitLinearSystem}
begin
InitLinearSystem;
end.
{Unit
LinearSystem}
=================================================================
IF we want spliting the wave file:
Ref: http://delphiworld.narod.ru/base/read_write_sound.html
=================================================================
IF we want spliting the wave file:
function SplitWave(Source, Dest1, Dest2: TFileName; Pos: Integer):
Boolean;
var
f1, f2,
f3: TfileStream;
w:
TWaveHeader;
p:
Integer;
begin
Result:=False
if
not
FileExists(Source) then
exit;
try
w :=
GetWaveHeader(Source);
p :=
Pos - Sizeof(TWaveHeader);
f1 :=
TFileStream.create(Source, fmOpenRead);
f2 :=
TFileStream.create(Dest1, fmCreate);
f3 :=
TFileStream.create(Dest2, fmCreate);
{Create file 1 }
w.len
:= p;
f2.Write(w, Sizeof(w));
f1.position := Sizeof(w);
f2.CopyFrom(f1, p);
{Create file
2}
w.len
:= f1.size - Pos;
f3.write(w, Sizeof(w));
f1.position := Pos;
f3.CopyFrom(f1, f1.size - pos);
finally
f1.free;
f2.free;
f3.free;
end;
Result:=True;
end;
