home *** CD-ROM | disk | FTP | other *** search
/ Multi-CD Magazin 1993 January / MultiCDMagazin0193_2ndEd.bin / cdplayer / cdisc.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-06  |  7KB  |  246 lines
  1. UNIT CDISC;
  2.  
  3. INTERFACE
  4.  
  5. USES WINTYPES,STRINGS,MMSYSTEM,COMMON;
  6.  
  7.  
  8. Type      TCDFailProc = Procedure (dwRC:LongInt; pRC:pChar);
  9.  
  10.  
  11. Type      PCompactDisc = ^TCompactDisc;
  12.           TCompactDisc = Object
  13.                            fpCDFailProc : TCDFailProc;
  14.                            hParent:HWND;
  15.                            hDisc:Word;
  16.                            Constructor Init (hAParent:HWND);
  17.                            Destructor Done; VIRTUAL;
  18.                            Function SetFailProc (fpFP:TCDFailProc):Integer;
  19.                            Function IsPresent:Boolean;
  20.                            Function IsPlaying:Boolean;
  21.                            Function Stop:Integer;
  22.                            Function Play (pszFrom:pChar):Integer;
  23.                            Function Eject:Integer;
  24.                            Function GetDiscLength:pChar;
  25.                            Function GetTrackCount:pChar;
  26.                            Function GetTrackLength (szTrack:TCharArray):pChar;
  27.                            Function GetCurrentTrack:pChar;
  28.                            Function GetCurrentTrackTime:pChar;
  29.                            PRIVATE
  30.                            Procedure Failure (dwRC:LongInt);
  31.                            Function AsStr (i,iW:Integer):pChar;
  32.                          End;
  33.  
  34.  
  35. IMPLEMENTATION
  36.  
  37.  
  38. Procedure FailProc (dwRC:LongInt; pRC:pChar);FAR;
  39. Begin;
  40.  { FEHLER AUSSITZEN... }
  41. End;
  42.  
  43.  
  44.  
  45. Constructor TCompactDisc.Init (hAParent:HWND);
  46.  Var mciOpenPrm : TMCI_OPEN_PARMS;
  47.       mciSetPrm : TMCI_SET_PARMS;
  48.              dw : LongInt;
  49. Begin;
  50.   fpCDFailProc:=FailProc;
  51.   hParent:=hAParent;
  52.  { TRY TO OPEN CD }
  53.   mciOpenPrm.DWCALLBACK:=0;
  54.   mciOpenPrm.LPSTRDEVICETYPE:='CDAUDIO';
  55.   dw:=mciSendCommand (0,MCI_OPEN,MCI_OPEN_TYPE,LONGINT(@mciOpenPrm));
  56.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  57.  { WE CAN OPEN, SO GET THE DEVICE ID }
  58.   hDisc:=mciOpenPrm.WDEVICEID;
  59.  { TRY TO SET TIME FORMAT }
  60.   mciSetPrm.DWCALLBACK:=0;
  61.   mciSetPrm.DWTIMEFORMAT:=MCI_FORMAT_TMSF;
  62.   dw:=mciSendCommand (hDisc,MCI_SET,MCI_SET_TIME_FORMAT,LONGINT(@mciSetPrm));
  63.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  64. End;
  65.  
  66.  
  67.  
  68. Destructor TCompactDisc.Done;
  69.  Var mciGenPrm : TMCI_GENERIC_PARMS;
  70. Begin;
  71.   mciGenPrm.DWCALLBACK:=0;
  72.   mciSendCommand (hDisc,MCI_CLOSE,MCI_WAIT,LONGINT(@mciGenPrm));
  73. End;
  74.  
  75.  
  76.  
  77. Function TCompactDisc.Stop:Integer;
  78.  Var mciGenPrm : TMCI_GENERIC_PARMS;
  79. Begin;
  80.   mciGenPrm.DWCALLBACK:=0;
  81.   mciSendCommand (hDisc,MCI_STOP,MCI_WAIT,LONGINT(@mciGenPrm));
  82.   Stop:=0;
  83. End;
  84.  
  85.  
  86.  
  87. Function TCompactDisc.Eject:Integer;
  88.  Var mciSetPrm : TMCI_SET_PARMS;
  89. Begin;
  90.   mciSendCommand (hDisc,MCI_SET,MCI_SET_DOOR_OPEN,LONGINT(@mciSetPrm));
  91.   Eject:=0;
  92. End;
  93.  
  94.  
  95. Function TCompactDisc.GetTrackLength (szTrack:TCharArray):pChar;
  96.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  97.           xbuf,buf : TCharArray;
  98.          liTime,dw : LongInt;
  99.                 rc : Integer;
  100. Begin;
  101.   mciStatusPrm.DWCALLBACK:=0;
  102.   mciStatusPrm.DWITEM:=MCI_STATUS_LENGTH;
  103.   Val (szTrack,mciStatusPrm.DWTRACK,rc);
  104.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM OR MCI_TRACK,LONGINT(@mciStatusPrm));
  105.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  106.   liTime:=mciStatusPrm.DWRETURN;
  107.   StrCopy (buf,AsStr(MCI_MSF_MINUTE(liTime),2)); StrCat (buf,':');
  108.   StrCat (buf,AsStr(MCI_MSF_SECOND(liTime),2));
  109.   GetTrackLength:=buf;
  110. End;
  111.  
  112.  
  113. Function TCompactDisc.GetDiscLength:pChar;
  114.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  115.                buf : TCharArray;
  116.          liTime,dw : LongInt;
  117. Begin;
  118.   mciStatusPrm.DWCALLBACK:=0;
  119.   mciStatusPrm.DWITEM:=MCI_STATUS_LENGTH;
  120.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  121.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  122.   liTime:=mciStatusPrm.DWRETURN;
  123.   StrCopy (buf,AsStr(MCI_MSF_MINUTE(liTime),2)); StrCat (buf,':');
  124.   StrCat (buf,AsStr(MCI_MSF_SECOND(liTime),2));
  125.   GetDiscLength:=buf;
  126. End;
  127.  
  128.  
  129.  
  130. Function TCompactDisc.GetTrackCount:pChar;
  131.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  132.                buf : TCharArray;
  133.            liTC,dw : LongInt;
  134. Begin;
  135.   mciStatusPrm.DWCALLBACK:=0;
  136.   mciStatusPrm.DWITEM:=MCI_STATUS_NUMBER_OF_TRACKS;
  137.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  138.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  139.   liTC:=mciStatusPrm.DWRETURN;
  140.   Str (liTC:2,buf);
  141.   If (buf[0]=' ') Then buf[0]:='0';
  142.   GetTrackCount:=buf;
  143. End;
  144.  
  145.  
  146.  
  147. Function TCompactDisc.IsPlaying:Boolean;
  148.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  149.                 dw : LongInt;
  150. Begin;
  151.   mciStatusPrm.DWCALLBACK:=0;
  152.   mciStatusPrm.DWITEM:=MCI_STATUS_MODE;
  153.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  154.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  155.   IsPlaying:=(mciStatusPrm.DWRETURN=MCI_MODE_PLAY);
  156. End;
  157.  
  158.  
  159.  
  160. Function TCompactDisc.IsPresent:Boolean;
  161.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  162.                 dw : LongInt;
  163. Begin;
  164.   mciStatusPrm.DWCALLBACK:=0;
  165.   mciStatusPrm.DWITEM:=MCI_STATUS_MEDIA_PRESENT;
  166.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  167.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  168.   IsPresent:=(mciStatusPrm.DWRETURN<>0);
  169. End;
  170.  
  171.  
  172.  
  173. Function TCompactDisc.Play (pszFrom:pChar):Integer;
  174.  Var  mciPlayPrm : TMCI_PLAY_PARMS;
  175.               dw : LongInt;
  176.         iFrom,rc : Integer;
  177. Begin;
  178.   Val (pszFrom,iFrom,rc);
  179.   mciPlayPrm.DWCALLBACK:=hParent;
  180.   mciPlayPrm.DWFROM:=MCI_MAKE_TMSF (iFrom,0,0,0);
  181.   dw:=mciSendCommand (hDisc,MCI_PLAY,MCI_FROM OR MCI_NOTIFY,LONGINT(@mciPlayPrm));
  182.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  183.   Play:=0;
  184. End;
  185.  
  186.  
  187.  
  188. Function TCompactDisc.GetCurrentTrack:pChar;
  189.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  190.                buf : TCharArray;
  191.                 dw : LongInt;
  192.               iTrk : Integer;
  193. Begin;
  194.   mciStatusPrm.DWCALLBACK:=0;
  195.   mciStatusPrm.DWITEM:=MCI_STATUS_CURRENT_TRACK;
  196.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  197.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  198.   iTrk:=mciStatusPrm.DWRETURN;
  199.   Str (iTrk:2,buf); If (buf[0]=' ') Then buf[0]:='0';
  200.   GetCurrentTrack:=buf;
  201. End;
  202.  
  203.  
  204. Function TCompactDisc.GetCurrentTrackTime:pChar;
  205.  Var  mciStatusPrm : TMCI_STATUS_PARMS;
  206.                 dw : LongInt;
  207.                buf : TCharArray;
  208. Begin;
  209.   mciStatusPrm.DWCALLBACK:=0;
  210.   mciStatusPrm.DWITEM:=MCI_STATUS_POSITION;
  211.   dw:=mciSendCommand (hDisc,MCI_STATUS,MCI_STATUS_ITEM,LONGINT(@mciStatusPrm));
  212.   If (dw<>0) Then Begin; Failure (dw); EXIT; End;
  213.   StrCopy (buf,AsStr(MCI_TMSF_MINUTE(mciStatusPrm.DWRETURN),2)); StrCat (buf,':');
  214.   StrCat (buf,AsStr(MCI_TMSF_SECOND(mciStatusPrm.DWRETURN),2));
  215.   GetCurrentTrackTime:=buf;
  216. End;
  217.  
  218.  
  219. Function TCompactDisc.AsStr (i,iW:Integer):pChar;
  220.  Var  buf:TCharArray;
  221.         s:String;
  222. Begin;
  223.   Str (i:iW,s);
  224.   While (Pos(' ',s)<>0) Do s[Pos(' ',s)]:='0';
  225.   AsStr:=StrPCopy(buf,s);
  226. End;
  227.  
  228.  
  229. Function TCompactDisc.SetFailProc (fpFP:TCDFailProc):Integer;
  230. Begin;
  231.   fpCDFailProc:=fpFP;
  232. End;
  233.  
  234.  
  235. Procedure TCompactDisc.Failure (dwRC:LongInt);
  236.  Var szRC:TCharArray;
  237. Begin;
  238.   mciGetErrorString (dwRC,szRC,SizeOf(szRC)-1);
  239.   fpCDFailProc (dwRC,szRC);
  240. End;
  241.  
  242.  
  243.  
  244.  
  245. END.
  246.