Programming Sound Cards/Programming Sound Cards.iso/sound_80/cdplay.pas

Pascal/Delphi Source File | 1995-01-01 | 5.3 KB | 231 lines

unit CDPlay;
{
  Copyright (c) June 1993, by Charlie Calvert
  Feel free to use this code as an adjunct to your own programs.

  This unit is the object oriented interface
  to the DLLs that control a CD player.
}
interface
uses
  CDUnit,
  MmSystem,
  ODialogs,
  OWindows,
  PlayDlg,
  PlayerId,
  Strings,
  WinProcs,
  WinTypes;

const
  ID_CURTRACK = 126;
  ID_CURTIME = 127;

type
  PCDDialog = ^TCDDialog;
  TCDDialog = Object(TPlayDialog)
      NumTracks: LongInt;
    constructor Init(AParent: PWindowsObject; AName: PChar);
    destructor Done; virtual;
    procedure SetUpWindow; virtual;
    procedure GetInfoFiles;
    procedure ReportStatus; virtual;
    procedure SelectSongs(var Msg: TMessage);
      virtual id_First + id_CdTrackList;
    procedure DeSelectSongs(var Msg: TMessage);
      virtual id_First + id_CdPlayList;
    procedure Abort(var Msg: TMessage);
      virtual id_First + idAbort;
    procedure BeginPlay(var Msg: TMessage);
      virtual id_First + ID_CDPlay;
    procedure MciNotify(var Msg: TMessage);
      virtual wm_First + mm_MciNotify;
    procedure WMTimer(var Msg: TMessage);
      virtual wm_First + wm_Timer;
  end;

implementation
{--------------------------------------------------}
{ TCDPlayer's method implementations:              }
{--------------------------------------------------}
constructor TCDDialog.Init(AParent: PWindowsObject; AName: PChar);
begin
  inherited Init(AParent, AName);
end;

destructor TCDDialog.Done;
begin
  if GetDeviceID > 0 then begin
    StopMCI;
    CloseMci;
  end;
  inherited Done;
end;

procedure FillTrackBox(HWindow: HWnd; NumTracks: LongInt; S: PChar);

type
  TInfo = Record
    Track, Min, Sec, Frame: Word;
  end;

var
  Info: TInfo;
  i: Integer;
  Min,Sec,Frame: Byte;

begin
  for i := 1 to NumTracks do begin
    GetTrackLength(i, Min, Sec, Frame);
    Info.Track := i;
    Info.Min := Min;
    Info.Sec := Sec;
    Info.Frame := Frame;
    WvsPrintF(S, 'Track: %d  >> Time: %d:%d', Info);
    SendDlgItemMessage(HWindow, ID_CDTrackList, lb_AddString, 0, LongInt(S));
  end;
end;

procedure TCDDialog.SetUpWindow;
begin
  inherited SetUpWindow;
  if not OpenCD(hWindow) then exit;
  while not HasDiskInserted do
    MessageBox(HWindow, 'Insert Disk', 'Foo', mb_Ok);
  GetInfoFiles;
end;

procedure TCDDialog.ReportStatus;
type
  TTimeAry = Array[0..1] of Word;

var
  S: PChar;
  Track: LongInt;
  Time: LongInt;
  TimeAry: TTimeAry;

begin
  GetMem(S, 100);
  Mode := GetMode;
  GetStatus;
  Track := GetCurrentCDTrack;
  WvsPrintF(S, '%ld', Track);
  SendDlgItemMessage(hWindow, ID_CURTRACK, WM_SETTEXT, 0, LongInt(S));
  Time := GetLocation;
  TimeAry[1] := MCI_TMSF_SECOND(Time);
  TimeAry[0] := MCI_TMSF_MINUTE(Time);
  WvsPrintF(S, '%d:%d', TimeAry);
  SendDlgItemMessage(hWindow, ID_CURTIME, WM_SETTEXT, 0, LongInt(S));
  FreeMem(S, 100);
end;

procedure TCdDialog.SelectSongs(var Msg: TMessage);
var
  S: array[0..200] of Char;
  Sel: LongInt;
begin
  case Msg.lParamHi of
    lbn_DblClk: begin
      Sel := SendDlgItemMessage(HWindow, ID_CDTrackList, lb_GetCurSel, 0, 0);
      if Sel <> lb_Err then begin
        SendDlgItemMessage(HWindow, ID_CDTrackList, lb_GetText, Sel, LongInt(@S));
        SendDlgItemMessage(HWindow, ID_CDPlayList, lb_AddString, Sel, LongInt(@S));
      end;
    end;
  end;
end;

procedure TCdDialog.DeSelectSongs(var Msg: TMessage);
var
  Sel: LongInt;
begin
  case Msg.lParamHi of
    lbn_DblClk: begin
      Sel := SendDlgItemMessage(HWindow, ID_CDPlayList, lb_GetCurSel, 0, 0);
      if Sel <> lb_Err then
        SendDlgItemMessage(HWindow, ID_CDPlayList, lb_DeleteString, Sel, 0);
    end;
  end;
end;

procedure TCdDialog.GetInfoFiles;
const
  Max = 50;

var
  S: PChar;

begin
{  SetMSFasFormat; }
  SetTMSFasFormat;
  NumTracks := GetNumTracks;
  GetMem(S, Max);
  wvsPrintF(S, '%d', NumTracks);
  SendDlgItemMessage(HWindow, ID_CDNumTracks, Em_LimitText, Max, 0);
  SendDlgItemMessage(HWindow, ID_CDNumTracks, Wm_SetText, 0, LongInt(S));
  FreeMem(S, Max);
  FillTrackBox(HWindow, NumTracks, S);
end;

procedure TCDDialog.Abort(var Msg: TMessage);
begin
  StopMci;
  ReportStatus;
end;

function Parse(S: PChar): Byte;
var
  S1: PChar;
  S2: array[0..50] of Char;
  i,j: Integer;
begin
  S1 := StrPos(S,':');
  i := 1;
  j := 0;
  while S1[i] <> '>' do begin
    if S1[i] <> ' ' then begin
      S2[j] := S1[i];
      inc(j);
    end;
    inc(i);
  end;
  S2[j] := #0;
  Val(S2, i, j);
  Parse := i;
end;

procedure TCDDialog.BeginPlay(var Msg: TMessage);
var
  S: array[0..200] of Char;
  Start: Byte;
begin
  if (SendDlgItemMessage(HWindow, ID_CDPlayList,
                         lb_GetText, 0, LongInt(@S)) = lb_Err) then begin
    MessageBox(HWindow, 'You must select a track first' , 'Info', Mb_Ok);
    Exit;
  end;
  Start := Parse(S);
  StartTimer;
  if Start <> NumTracks then
    PlayMciCD(Start, Start + 1)
  else
    PlayCDOneTrack(Start);
{  SetMSFasFormat; }
  ReportStatus;
end;

procedure TCDDialog.MciNotify(var Msg: TMessage);
begin
  {  KillTimer(HWindow, PlayTimer); }
  ReportStatus;
  if Mode = Mci_Mode_Stop then CloseMci;
end;

procedure TCDDialog.WMTimer(var Msg: TMessage);
begin
  ReportStatus;
end;

end.