conv.htm

来自「对于学习很有帮助」· HTM 代码 · 共 1,101 行 · 第 1/2 页

                  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 observation}
                       yyy        : DataStream; {Array of data points}
                       WAV        : WAVHeader;  {WAV specs for observation}
                       Last       : SampleIndex;{Last valid index to yyy}
                       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<MaxN then ChunkSize.dn := trunc(Ki.yyy[N+1]+0.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 & increment 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<MaxN then Ki.yyy[N+1]:=1.0*ChunkSize.dn;
                    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
       {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<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); {Attempt to read beyond MaxNumberOfDataBaseItems} 
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}

{======================= 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}
</PRE><HR>



<HR SIZE="6" color="#00FF00">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</body>
</html>