返回
{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                   CD播放器支持单元                      ***}
{***************************************************************}
{$O+,F+,X+}
Unit FCDDrv;
Interface
Const
  CDInstalled:Boolean=False;

var
  CDDriver     :Integer;
  CDMusNum     :Integer;
  CDSector     :Integer;
  CDSecond     :Integer;
  CDMinute     :Integer;
  CD_Sector    :Integer;
  CD_Second    :Integer;
  CD_Minute    :Integer;
  CD_Cur_Music :Integer;
  CD_Cur_Minute:Integer;
  CD_Cur_Second:Integer;
  CD_All_Minute:Integer;
  CD_All_Second:Integer;

Function  CDexist:Boolean;
Procedure GetCDDrvInfo;
Procedure GetMusStart(Mus:Integer);
Procedure GetCDStatus;
Procedure PlayCD(Mus:Integer;Continue,MultPlay:Boolean);
Procedure StopCD;
Implementation
Uses
  Dos;

Type
  CDDrvBufType=array[0..25] of Byte;

Var
  CDDrvBuf,CDInfoBuf:CDDrvBufType;

Function CDExist:Boolean;
var
  R:Registers;
begin
  CDExist:=True;
  CDInstalled:=True;
  R.AX:=$1500;
  R.BX:=0;
  Intr($2F,R);
  if R.BX=0 then
  begin
    CDExist:=False;
    CDInstalled:=False;
  end;
  CDDriver:=R.CX;
end;

Procedure SendRequire;
var
  R:Registers;
begin
  if not CDInstalled then Exit;
  R.AX:=$1510;
  R.CX:=CDDriver;
  R.ES:=Seg(CDDrvBuf);
  R.BX:=Ofs(CDDrvBuf);
  Intr($2F,R);
end;

procedure GetCDInfo(Len:Byte);
begin
  FillChar(CDDrvBuf,26,0);
  CDDrvBuf[0]:=$1A;
  CDDrvBuf[1]:=0;
  CDDrvBuf[2]:=3;
  CDDrvBuf[$0E]:=Lo(Ofs(CDInfoBuf));
  CDDrvBuf[$0F]:=Hi(Ofs(CDInfoBuf));
  CDDrvBuf[$10]:=Lo(Seg(CDInfoBuf));
  CDDrvBuf[$11]:=Hi(Seg(CDInfoBuf));
  CDDrvBuf[$12]:=Len;
  SendRequire;
end;

procedure GetCDDrvInfo;
begin
  FillChar(CDInfoBuf,26,0);
  CDInfoBuf[0]:=$0A;
  GetCDInfo(7);
  CDMusNum:=CDInfoBuf[2];
  CDSector:=CDInfoBuf[3];
  CDSecond:=CDInfoBuf[4];
  CDMinute:=CDInfoBuf[5];
end;

procedure GetMusStart(Mus:Integer);
begin
  FillChar(CDInfoBuf,26,0);
  CDInfoBuf[0]:=$0B;
  CDInfoBuf[1]:=Mus;
  GetCDInfo(7);
  CD_Sector:=CDInfoBuf[2];
  CD_Second:=CDInfoBuf[3];
  CD_Minute:=CDInfoBuf[4];
end;

procedure GetCDStatus;
begin
  FillChar(CDInfoBuf,26,0);
  CDInfoBuf[0]:=$0C;
  GetCDInfo(11);
  CD_Cur_Music :=(CDInfoBuf[2] shr 4)*10+(CDInfoBuf[2] and $0F);
  CD_Cur_Minute:=CDInfoBuf[4];
  CD_Cur_Second:=CDInfoBuf[5];
  CD_All_Minute:=CDInfoBuf[8];
  CD_All_Second:=CDInfoBuf[9];
end;

procedure PlayCD(Mus:Integer;Continue,MultPlay:Boolean);
var
  TotalSec,TempSec:Longint;
begin
  if (Mus<CDMusNum) and (not MultPlay) then
  begin
    GetMusStart(Mus+1);
    TempSec:=CD_Minute*60+CD_Second;
  end else
    TempSec:=CDMinute*60+CDSecond;
  if Continue then
  begin
    GetCDStatus;
    TotalSec:=TempSec-CD_All_Minute*60-CD_All_Second;
  end else
  begin
    GetMusStart(Mus);
    TotalSec:=TempSec-CD_Minute*60-CD_Second;
  end;
  TotalSec:=TotalSec*75;
  FillChar(CDDrvBuf,26,0);
  CDDrvBuf[0]:=$16;
  CDDrvBuf[1]:=0;
  CDDrvBuf[2]:=$84;
  CDDrvBuf[$0D]:=$01;
  if Continue then
    CDDrvBuf[$0E]:=0
  else
    CDDrvBuf[$0E]:=CD_Sector;
  if Continue then
    CDDrvBuf[$0F]:=CD_All_Second
  else
    CDDrvBuf[$0F]:=CD_Second;
  if Continue then
    CDDrvBuf[$10]:=CD_All_Minute
  else
    CDDrvBuf[$10]:=CD_Minute;
  CDDrvBuf[$12]:=Byte(TotalSec and $FF);
  CDDrvBuf[$13]:=Byte((TotalSec shr 8) and $FF);
  CDDrvBuf[$14]:=Byte((TotalSec shr 16) and $FF);
  CDDrvBuf[$15]:=Byte((TotalSec shr 24) and $FF);
  SendRequire;
end;

procedure StopCD;
begin
  FillChar(CDDrvBuf,26,0);
  CDDrvBuf[0]:=$0D;
  CDDrvBuf[1]:=0;
  CDDrvBuf[2]:=$85;
  SendRequire;
end;

begin
end.