{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                    MIDI文件单元                         ***}
{***************************************************************}
Unit FMidi;
Interface
Uses
  Dos,FDsp;

Type
  TrackType=record
   Length:Longint;
   Point:Pointer;
  end;

  TMidiFile=object
   Error:Boolean;
   Fp:File;
   FileName:PathStr;
   Result:Word;
   TrackChunks:Word;
   Division:Word;
   Tracks:array[1..10] of TrackType;
   constructor Init(Name:PathStr);
   destructor Done;virtual;
   procedure Play;
  end;



Implementation
Type
  ConType=array[1..64000] of Byte;

constructor TMidiFile.Init;
var
  i:Integer;
  Temp:array[0..13] of Byte;
begin
  Error:=False;
  FileName:=Name;
  Assign(Fp,FileName);
  {$i-}Reset(Fp,1);{$i+}
  BlockRead(Fp,Temp,14,Result);
  TrackChunks:=Word(Temp[10] shl 8)+Temp[11];
  Division:=Word(Temp[12] shl 8)+Temp[13];
  for i:=1 to TrackChunks do
  begin
    BlockRead(Fp,Temp,8,Result);
    Tracks[i].Length:=Longint(Temp[4] shl 24)+Longint(Temp[5] shl 16)+
                      Longint(Temp[6] shl 8)+Longint(Temp[7]);
    GetMem(Tracks[i].Point,Tracks[i].Length);
    BlockRead(Fp,Tracks[i].Point^,Tracks[i].Length,Result);
  end;
end;

destructor TMidiFile.Done;
var
  i:Integer;
begin
  for i:=1 to TrackChunks do
  FreeMem(Tracks[i].Point,Tracks[i].Length);
end;

procedure TMidiFile.Play;
var
  i,j:Integer;
begin
  SpeakerOn;
  for i:=1 to TrackChunks do
  for j:=1 to Tracks[i].Length do
  WriteMidi(ConType(Tracks[i].Point^)[j]);
  SpeakerOff;
end;

end.