网页功能: 加入收藏 设为首页 网站搜索  
wave文件格式说明
发表日期:2003-05-28作者:[] 出处:  

unit LinearSystem;

interface

{============== WAV Format Coding Type ==================}

type WAVHeader = record

nChannels : Word;

nBitsPerSample : LongInt;

nSamplesPerSec : LongInt;

nAvgBytesPerSec : LongInt;

RIFFSize : LongInt;

fmtSize : LongInt;

formatTag : Word;

nBlockAlign : LongInt;

DataSize : LongInt;

end;

{============== Sample DataStreams ========================}

const MaxN = 300; { max number of sample values }

type SampleIndex = 0 .. MaxN+3;

type DataStream = array[ SampleIndex ] of Real;

var N : SampleIndex;

{============== Observation Variables ======================}

type Observation = record

Name : String[40]; {Name of this observat

ion}

yyy : DataStream; {Array of data points}

WAV : WAVHeader; {WAV specs for observa

tion}

Last : SampleIndex;{Last valid index to y

yy}

MinO, MaxO : Real; {Range values from yyy

}

end;

var K0R, K1R, K2R, K3R : Observation;

K0B, K1B, K2B, K3B : Observation;

{================== File Name Variables ===================}

var StandardDatabase : String[ 80 ];

BaseFileName : String[ 80 ];

StandardOutput : String[ 80 ];

StandardInput : String[ 80 ];

{=============== Operations ==================}

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;

{================== Standard WAV File Format ===================}

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)

);

{================== Scale Observation Data ===================}

procedure ScaleData(var Kk : Observation);

var I : SampleIndex;

begin

{Initialize the scale values}

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

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

{Then scan for any higher or lower values}

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 Data I/O ===================}

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-bit samples in buffer for one channel}

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

if N .5);

N := N+2;

end

else begin {1..4 8-bit samples in buffer for one channel}

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-bit samples on two channels}

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

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

N := N+1;

end

else begin {4 8-bit samples on two channels}

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; {the four-byte variable "ChunkSize" has now been filled}

ChunkSize.x:=T1;

WriteChunkSize(ChunkSize.lint);{put 4 bytes of data}

end; {WriteOneDataBlock}

procedure WriteWAVFile(var Ki, Kj : Observation);

var MM : Byte;

I : Integer;

OK : Boolean;

begin

{Prepare to write a file of data}

AssignFile(OutFile, StandardOutput); { File selected in dialog }

ReWrite( OutFile );

With Ki.WAV do

begin DataSize := nChannels*(nBitsPerSample div 8)*(Ki.Last+1);

RIFFSize := DataSize+36;

fmtSize := 16;

end;

{Write ChunkName "RIFF"}

WriteChunkName('RIFF');

{Write ChunkSize}

WriteChunkSize(Ki.WAV.RIFFSize);

{Write ChunkName "WAVE"}

WriteChunkName('WAVE');

{Write tag "fmt_"}

WriteChunkName('fmt ');

{Write ChunkSize}

Ki.WAV.fmtSize := 16; {should be 16-18}

WriteChunkSize(Ki.WAV.fmtSize);

{Write formatTag, nChannels}

WriteChunkWord(Ki.WAV.formatTag);

WriteChunkWord(Ki.WAV.nChannels);

{Write nSamplesPerSec}

WriteChunkSize(Ki.WAV.nSamplesPerSec);

{Write nAvgBytesPerSec}

WriteChunkSize(Ki.WAV.nAvgBytesPerSec);

{Write nBlockAlign, nBitsPerSample}

WriteChunkWord(Ki.WAV.nBlockAlign);

WriteChunkWord(Ki.WAV.nBitsPerSample);

{WriteDataBlock tag "data"}

WriteChunkName('data');

{Write DataSize}

WriteChunkSize(Ki.WAV.DataSize);

N:=0; {first write-out location}

while N<=Ki.Last do WriteOneDataBlock(Ki,Kj); {put 4 bytes & incr

ement N}

{Free the file buffers}

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; {get 4 bytes of data}

ChunkSize.x:=M1;

with Ki.WAV do

case nChannels of

1:if nBitsPerSample=16

then begin {1..2 16-bit samples in buffer for one channel}

Ki.yyy[N] :=1.0*ChunkSize.up;

if N N := N+2;

end

else begin {1..4 8-bit samples in buffer for one channel}

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 {2 16-bit samples on two channels}

Ki.yyy[N]:=1.0*ChunkSize.dn;

Kj.yyy[N]:=1.0*ChunkSize.up;

N := N+1;

end

else begin {4 8-bit samples on two channels}

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 { Bring up open file dialog }

OK := True; {unless changed somewhere below}

{Prepare to read a file of data}

AssignFile(InFile, StandardInput); { File selected in dialog }

Reset( InFile );

{Read ChunkName "RIFF"}

ReadChunkName;

if ChunkName<>'RIFF' then OK := False;

{Read ChunkSize}

ReadChunkSize;

RIFFSize := ChunkSize.lint; {should be 18,678}

{Read ChunkName "WAVE"}

ReadChunkName;

if ChunkName<>'WAVE' then OK := False;

{Read ChunkName "fmt_"}

ReadChunkName;

if ChunkName<>'fmt ' then OK := False;

{Read ChunkSize}

ReadChunkSize;

fmtSize := ChunkSize.lint; {should be 18}

{Read formatTag, nChannels}

ReadChunkSize;

ChunkSize.x := M1;

formatTag := ChunkSize.up;

nChannels := ChunkSize.dn;

{Read nSamplesPerSec}

ReadChunkSize;

nSamplesPerSec := ChunkSize.lint;

{Read nAvgBytesPerSec}

ReadChunkSize;

nAvgBytesPerSec := ChunkSize.lint;

{Read nBlockAlign}

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;

{Read nBitsPerSample}

nBitsPerSample := ChunkSize.dn;

for I := 17 to fmtSize do Read(InFile,MM);

NoDataYet := True;

while NoDataYet do

begin

begin

{Read tag "data"}

ReadChunkName;

{Read DataSize}

ReadChunkSize;

DataSize := ChunkSize.lint;

if ChunkName<>'data' then

begin

for I := 1 to DataSize do {skip over any nondata stuff}

Read(InFile,MM);

end

else NoDataYet := False;

end;

nDataBytes := DataSize;

{Finally, start reading data for nDataBytes bytes}

if nDataBytes>0 then DataYet := True;

N:=0; {first read-in location}

while DataYet do

begin

ReadOneDataBlock(Ki,Kj); {get 4 bytes}

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;

{Free the file buffers}

CloseFile( InFile );

end

else begin

InitSpecs;{file does not exist}

InitSignals(Ki);{zero "Ki" array}

InitSignals(Kj);{zero "Kj" array}

end;

end; { ReadWAVFile }

{================= Database Operations ====================}

const MaxNumberOfDataBaseItems = 360;

type SignalDirectoryIndex = 0 .. MaxNumberOfDataBaseItems;

VAR DataBaseFile : file of Observation;

LastDataBaseItem : LongInt; {Current number of database items}

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 then

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); {Attempt to read beyond MaxNumberOfDataBaseItems

}

end; {PutDatabaseItem}

procedure InitDataBase;

begin

LastDataBaseItem := 0;

if FileExists(StandardDataBase)

then

begin

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 begin

if Nstg=ItemNameS[ThisOne]

then begin

FindDataBaseName := ThisOne;

Exit;

end;

ThisOne := ThisOne+1;

end;

end; {FindDataBaseName}

{======================= Init Unit ========================}

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 {unit initialization code}

InitLinearSystem;

end. {Unit LinearSystem}

我来说两句】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 wave文件格式说明
本类热点文章
  DBGrid 应用全书
  DBGrid 应用全书
  TWebBrowser编程简述
  用户界面设计的技巧与技术
  用户界面设计的技巧与技术
  初探Delphi 7 中的插件编程
  获取主板BIOS的信息
  网卡的远程网络唤醒
  Delphi 2006简介(Dexter)
  用Delphi开发数据库程序经验三则
  Delphi面向对象编程的20条规则
  Delphi面向对象编程的20条规则
最新分类信息我要发布 
最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放  
Copyright ©2003-2024 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00524