// Manchmal braucht man Hintergrundmusik von einer CD für sein Programm.
// Mit nachfolgender Prozedur kann man bestimmte Titel von einem bestimmten
// Laufwerk spielen lassen
(Die Konstante "c" enthält während und nach
// dem Abspielen den gerade bzw. zuletzt benutzten Laufwerksbuchstaben)

// Getestet mit D4 unter Win98

uses mmsystem; 
 
const c: char = #0; 
 
procedure PlayAudio(st: string); 
const 
  pg = 'play geraet'; 
  pl = pg + ' from '; 
var 
  sl: TStringlist; 
  Titel, Laufw: string; 
  zweite: byte; 
  s: array[0..29] of char; 
begin 
  zweite := 255; 
  sl := TStringlist.create; 
  try 
    sl.commatext := st; 
    if sl.count > 0 then begin 
      c := sl[0][1]; 
      Laufw := c + ':'; 
      if sl.count = 1 then Titel := pg 
      else begin 
        if (sl.count = 2) or (sl.count > 2) and (sl[1] >= sl[2]) 
          then begin 
          if sl[1] = '0' then Titel := 'stop geraet' 
          else begin 
            Titel := pl + sl[1]; 
            zweite := strtoint(sl[1]) + 1; 
          end; 
        end else begin 
          Titel := pl + sl[1]; 
          zweite := strtoint(sl[2]); 
        end; 
      end; 
      mciSendString(pchar('open ' + Laufw + ' type cdaudio alias geraet'), 
        nil, 0, 0); 
      mciSendString(pchar('status geraet number of tracks wait'), s, 30, 0); 
      if zweite <= strtoint(s) then 
        Titel := Titel + ' to ' + inttostr(zweite); 
      mciSendString('set geraet time format tmsf', nil, 0, 0); 
      mciSendString(pchar(Titel), nil, 0, 0); 
      mciSendString('close geraet', nil, 0, 0); 
    end; 
  finally 
    sl.free; 
  end; 
end; 
 
// Alle Titel von Laufwerk G: spielen 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  PlayAudio('G:'); 
end; 
// Titel 3 von Laufwerk E: spielen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  PlayAudio('e:\,3'); 
end; 
// Die Titel 6 bis 9 von Laufwerk F: spielen 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  PlayAudio('F,6,9'); 
end; 
 
// Abspielen stoppen 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  PlayAudio(c + ',0') 
end;



Zugriffe seit 6.9.2001 auf Delphi-Ecke