home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue148 / delphi / CDPlayer / CDUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-20  |  8.6 KB  |  278 lines
  1. unit CDUnit;
  2.  
  3. interface
  4. {
  5.  
  6.   By default the AutoEnable property is set to True so that buttons are
  7. shown enabled (coloured) or disabled (grey out) as appropriate.
  8.  
  9. However, there is a problem when you add your own buttons to control the
  10. MediaPlayer. These buttons can call methods such as Pl;ay and Rewind but the
  11. set of MediaPlayer buttons won't be reliably toggled in respons to these
  12. method calls.
  13.  
  14. My simple fix for this (in my Rewind+Play method, DoRewind) is to disable
  15. the AutoEnabled property and disable the Play button by substracting it from
  16. the set of Enabled buttons:
  17.       AutoEnable := false;
  18.       EnabledButtons := EnabledButtons-[btPlay];
  19.  
  20. The AutoEnabled property is re-anebled to deal with click-events on
  21. the MediaPlayer in the MediaPlayer1Click method:
  22.   MediaPlayer1.AutoEnable := true;
  23.  
  24.   Limitations: Does not handle exception when some other Multimedia player
  25.   (such as the Windows CD player) has already opened the CD device.
  26.  
  27.   Author: Huw Collingbourne
  28. }
  29. uses
  30.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  31.   MPlayer, StdCtrls, ExtCtrls,
  32.   MMSystem, ComCtrls, Buttons;    { include MMSystem for access to Timing functions }
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Timer1: TTimer;
  37.     Panel1: TPanel;
  38.     DisplayBox: TEdit;
  39.     TrackTBar: TTrackBar;
  40.     MediaPlayer1: TMediaPlayer;
  41.     BitBtn1: TBitBtn;
  42.     RewindBtn: TButton;
  43.     StatusLabel: TLabel;
  44.     procedure MediaPlayer1PostClick(Sender: TObject; Button: TMPBtnType);
  45.     procedure Timer1Timer(Sender: TObject);
  46.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  47.     procedure FormActivate(Sender: TObject);
  48.     procedure BitBtn1Click(Sender: TObject);
  49.     procedure RewindBtnClick(Sender: TObject);
  50.     procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
  51.       var DoDefault: Boolean);
  52.   private
  53.     { Private declarations }
  54.     Track : integer;
  55.     prevTrack : integer;
  56.   public
  57.     { Public declarations }
  58.     procedure resetTrackBar( Pos : longint );
  59.     procedure DecodeTMSFMinSec( TMSF : LongInt; Var Minutes, Seconds : longint );
  60.     procedure DecodeMSFMinSec( MSF : LongInt; Var Minutes, Seconds : longint );
  61.     function CurrTrack : longint;
  62.     function TracklenStr : string;
  63.     function CDlenStr : string;
  64.     function CDReady( var errmsg : string) : boolean;
  65.     procedure DoRewind;
  66.   end;
  67.  
  68. var
  69.   Form1: TForm1;
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74.  
  75. const
  76.   CDDRIVE = 'D'; // Change this if the CD drive is some other letter!
  77.   ModeStr: array[TMPModes] of string[10] = ('Not ready', 'Stopped', 'Playing',
  78.     'Recording', 'Seeking', 'Paused', 'Open');
  79.  
  80.  
  81. function AudioCD(Drive : char) : boolean;
  82. { Return True if an Audio CD is in the drive,
  83.   else return False.
  84.   Note: Refer to Win32 Programmers Reference for help on
  85.   GetDriveType and GetVolumeInformation.
  86.   Note: VolumeName = 'Audio CD' when an audio CD is loaded  }
  87. var
  88.   RootPathName : string;
  89.   MaxComponentLength : DWORD;
  90.   FileSystemFlags : DWORD;
  91.   VolumeName : string;
  92. begin
  93.   result := false;
  94.   RootPathName := Drive + ':\';
  95.   if GetDriveType(PChar(RootPathName)) = DRIVE_CDROM then
  96.   begin
  97.      SetLength(VolumeName, 64);
  98.      GetVolumeInformation(PChar(RootPathName),
  99.                        PChar(VolumeName),
  100.                        Length(VolumeName),
  101.                        nil,
  102.                        MaxComponentLength,
  103.                        FileSystemFlags,
  104.                        nil,
  105.                        0);
  106.      if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
  107.         result := true;
  108.   end; { if DRIVE_CDROM }
  109. end;
  110.  
  111. (* The two functions that follow decode a LongInt value into its Minutes
  112.    and Seconds components. They are similar apart from the fact that
  113.    they call different Win32 functions. Use them with care! *)
  114. procedure TForm1.DecodeTMSFMinSec( TMSF : LongInt; Var Minutes, Seconds : longint );
  115. { Input TMSF format int. Assign Minute and Second values to last 2 args }
  116. begin
  117.     Minutes := MCI_TMSF_MINUTE(TMSF);
  118.     Seconds := MCI_TMSF_SECOND(TMSF);
  119. end;
  120.  
  121. procedure TForm1.DecodeMSFMinSec( MSF : LongInt; Var Minutes, Seconds : longint );
  122. { Input MSF format int. Assign Minute and Second values to last 2 args }
  123. begin
  124.     Minutes := MCI_MSF_MINUTE(MSF);
  125.     Seconds := MCI_MSF_SECOND(MSF);
  126. end;
  127.  
  128.  
  129. function TForm1.currTrack : longint;
  130. { return current track number, indexed from 1 for 1st track }
  131. begin
  132.   result := MCI_TMSF_TRACK(MediaPlayer1.Position);
  133. end;
  134.  
  135.  
  136.  
  137. function TForm1.TracklenStr : string;
  138. { Return tracklength as a string, 'Min:Sec' }
  139. var
  140.    Min,Sec : longint;
  141. begin
  142.     DecodeMSFMinSec(Mediaplayer1.Tracklength[currTrack], min, sec);
  143.     result := Format('%.2d:%.2d', [min, sec]);
  144. end;
  145.  
  146. function TForm1.CDlenStr : string;
  147. { Return total CD playing length as a string, 'Min:Sec' }
  148. var
  149.    Min,Sec : longint;
  150. begin
  151.   DecodeMSFMinSec( MediaPlayer1.Length, Min, Sec);
  152.   result := Format('%.2d:%.2d', [min, sec]);
  153. end;
  154.  
  155. procedure TForm1.DoRewind;
  156. begin
  157.    with MediaPlayer1 do
  158.    begin
  159.       Stop;  // More reliable to Stop before Rewinding Player
  160.       Rewind;
  161.       Play;
  162.              // Disable Play button after Rewind. See comment at head of unit.
  163.       AutoEnable := false;
  164.       EnabledButtons := EnabledButtons-[btPlay];
  165.    end;
  166. end;
  167.  
  168. function TForm1.CDReady( var errmsg : string ) : boolean;
  169. { Checks that an Audio CD is in the drive. If so, return True.
  170.   If not, return False and assign an error message to errmsg argument }
  171. var
  172.    ok : boolean;
  173.    txt : string;
  174. begin
  175.    ok := false;
  176.    txt := '';
  177.    if MediaPlayer1.Error = 262 then{ a pre-defined'magic number' = empty drive }
  178.       txt := 'The CD drive seems to be empty!'
  179.    else if not (AudioCD( CDDRIVE )) then
  180.       txt := 'Insert an audio CD!'
  181.    else if MediaPlayer1.Error = 0 then
  182.       ok := true
  183.    else txt := MediaPlayer1.ErrorMessage;
  184.    if not ok then
  185.        errmsg := txt;
  186.    result := ok;
  187. end;
  188.  
  189.  
  190. procedure TForm1.MediaPlayer1PostClick(Sender: TObject;
  191.   Button: TMPBtnType);
  192. { check that CD is ready after the MediaPlayer has been clicked }
  193. var
  194.    msg : string;
  195. begin
  196.  msg := '';
  197.  if not CDReady( msg ) then
  198.     DisplayBox.Text := msg;
  199. end;
  200.  
  201. procedure TForm1.Timer1Timer(Sender: TObject);
  202. { Timer object updates the Trackbar and time-display info }
  203. var
  204.   Minutes : longint;
  205.   Seconds : longint;
  206.   msg     : string;
  207. begin
  208.   msg := '';
  209.   StatusLabel.Caption := ModeStr[MediaPlayer1.Mode];
  210.   if not CDReady( msg ) then
  211.   begin
  212.     Caption := msg;
  213.     DisplayBox.Text := 'CD not ready!';
  214.   end
  215.   else   //--- Main Block ---
  216.   begin  //--- if all is well execute this block to display track and CD info
  217.     Track := currTrack;
  218.     if Track <> prevTrack then { check for new track!                        }
  219.     begin
  220.      prevTrack := Track;       { assign prevTrack variable to new track      }
  221.      resetTrackBar( 0 );
  222.     end;
  223.                                { after each Timer event update time display  }
  224.     DecodeTMSFMinSec(MediaPlayer1.Position, Minutes, Seconds );
  225.     DisplayBox.Text := Format('[%.2d]   %.2d:%.2d', [Track,Minutes,Seconds]);
  226.     Caption := Format('[Track %.2d] Length: %s  |  CD Length: %s, Tracks: %.2d',
  227.                       [Track,TrackLenStr,CDLenStr,MediaPlayer1.Tracks]);
  228.                                { finally, move the TrackBar                  }
  229.     TrackTBar.Position := (60 * Minutes) + Seconds;
  230.   end;
  231. end;
  232.  
  233. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  234. begin
  235.   MediaPlayer1.Stop; { stop playing track when the app is closed }
  236. end;
  237.  
  238. procedure TForm1.FormActivate(Sender: TObject);
  239. { set Time Format and initialise prevTrack variable when App is loaded       }
  240. begin
  241.   Track := 0;
  242.   prevTrack := 0;
  243.   MediaPlayer1.TimeFormat := tfTMSF;
  244.   MediaPlayer1.Open; // Open CD device. Add exception handling here if you wish.
  245. end;
  246.  
  247. procedure TForm1.resetTrackBar( Pos : longint );
  248. { Reset the TrackBar (e.g. when a new Track starts playing) }
  249. var
  250.    Minutes, Seconds, MaxLen : longint;
  251. begin
  252.   DecodeMSFMinSec(Mediaplayer1.Tracklength[currTrack], Minutes, Seconds );
  253.   MaxLen := (60 * Minutes) + Seconds;
  254.   TrackTBar.Min := 0;                 { start pos   }
  255.   TrackTBar.Max := MaxLen;            { end pos     }
  256.   TrackTBar.Position := 0;            { current pos }
  257. end;
  258.  
  259. procedure TForm1.BitBtn1Click(Sender: TObject);
  260. begin
  261.   Close;
  262. end;
  263.  
  264. procedure TForm1.RewindBtnClick(Sender: TObject);
  265. begin
  266.   DoRewind;
  267. end;
  268.  
  269. procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
  270.   var DoDefault: Boolean);
  271. begin
  272. { When the MediaPlayer is clicked make sure that the buttons are automatically
  273.   enabled and disabled as appropriate }
  274.   MediaPlayer1.AutoEnable := true;
  275. end;
  276.  
  277. end.
  278.