XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Sound: Audio-CD abspielen
CD abspielen per MCI Dieter Zornow
declare CDerror&

Proc CD_Open  Öffnet die CD Device und setzt Zeitformat

    Declare open$
    parameters laufw$
    let open$=@Translate$(OPEN LW type cdaudio alias CD  shareable,LW,laufw$)
    @MCISend$(open$)
    @MCISend$(SET CD TIME FORMAT tmsf) Zeitformat Track, Minuten, Sekunden, Frames
    @MCISend$(SET CD TIME FORMAT msf) Zeitformat Minuten, Sekunden, Frames
    @MCISend$(SET CD TIME FORMAT ms) Zeitformat Milisekunden
    @MCISend$(SET CD AUDIO ALL ON) Öffnet Audio Output auf beiden Kanälen (OFF schließt, Left ON, Right On und off)

EndProc

Proc CD_Stop

    @MCISend$(STOP CD) Stoppt das Abspielen

EndProc

Proc CD_Close

    @MCISend$(CLOSE CD) Schließt die Device

EndProc

proc CD_Error

    if %mcierror

        declare tz$,mess$
        let tz$=Device Error
        let mess$=Sorry, The Player can´t play the CD,
        please make sure your default drive is ready to play
        and try again.
        @messagebox(mess$,tz$,48)
        CD_Close
        let CDerror&=1
        return CDerror&

    endif

    let CDerror&=0
    return CDerror&

endproc

Proc CD_present

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD MEDIA PRESENT)  Ist eine CD eingelegt?
    Return CD_Result$ (True, false)

Endproc

Proc CD_Ready

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD READY)  Ist das Gerät bereit ?
    Return CD_Result$ (True, false)

Endproc

Proc CD_Opendoor

    @MCISend$(Set CD door open) Öffnet die CD Schublade

EndProc

Proc CD_Closedoor

    @MCISend$(Set CD door closed) Schließt die CD Schublade

EndProc

Proc CD_Play

    CD_ERROR
    case equ(CDerror&,0):@MCISend$(PLAY CD)  Spielt die ganze CD

EndProc

Proc CD_PlayFromTo

    parameters from$,to$
    CD_Error
    case equ(CDerror&,0):@MCISend$(PLAY CD FROM +from$+ TO +To$)  Spielt die CD von Track bis Track mit Parameter from$ to$

EndProc

Proc CD_SeekToEnd

    CD_Error
    case equ(CDerror&,0):@MCISend$(SEEK CD TO END) Sucht Vorwärts bis zum Ende

EndProc

Proc CD_SeekToStart

    CD_error
    case equ(CDerror&,0):@MCISend$(SEEK CD TO START) Sucht Rückwärts bis zum Anfang

EndProc

Proc CD_SeekTO

    Parameters pos$
    @MCISend$(SEEK CD TO +pos$) Sucht bis zur Position Track oder Frame(Parameter Track oder Frame)

EndProc

Proc CD_PlayWait

    CD_Error
    case equ(CDerror&,0):@MCISend$(PLAY CD WAIT) spielt die cd und das Programm hält an

EndProc

Proc CD_Pause

    @MCISend$(PAUSE CD) Pausiert, manche Treiber spielen beim 2ten mal Pause weiter /RESUME/

EndProc

Proc CD_Resume

    @MCISend$(RESUME CD) Spielt nach Pause weiter an der gleichen Stelle

EndProc

Proc CD_Status

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD MODE)zeigt den Zustand
    Return CD_Result$ (stopped, playing, paused, not ready open, seeking.)

EndProc

Proc CD_Break

    @MCISend$(Break CD on 27)Waitplay abbrechen mit ESC Taste

endproc

Proc CD_T_number

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD NUMBER OF TRACKS)  Anzahl der Musikstücke
    Return CD_Result$

endproc

Proc CD_length

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD LENGTH)  Länge der Musik CD
    Return CD_Result$

Endproc

Proc CD_CurrentTr

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD CURRENT TRACK )  Nr des aktuellen Tracks
    Return CD_Result$

Endproc

Proc CD_Tracklength

    parameters nr$
    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD LENGTH TRACK +nr$)  Länge des aktuellen Titels (parameter nr$)
    Return CD_Result$

Endproc

Proc CD_position

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD POSITION) aktuelle Position auf der CD
    Return CD_Result$

Endproc

Proc CD_TSposition

    parameters nr$
    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD POSITION TRACK +nr$) Startposition der Tracks parameter Nr%
    Return CD_Result$

Endproc

Proc CD_Sposition

    Declare CD_Result$
    Let CD_Result$=@MCISend$(STATUS CD START POSITION) Startposition auf der CD
    Return CD_Result$

Endproc

Proc CD_Info

    Declare CD_Result$
    Let CD_Result$=@MCISend$(INFO CD PRODUKT) Gibt Name des CD_Laufwerkes
    Return CD_Result$

Endproc

proc CD_muteON

    @MCISend$(SET CD AUDIO ALL OFF)

endproc

proc CD_muteOFF

    @MCISend$(SET CD AUDIO ALL ON)

endproc

Beispiel
cls
Declare status$
CD_Open I: Laufwerksbuchstabe anpassen
CD_Ready
Print CD Device ready?:,@$(0)
CD_present
Print CD vorhanden:,@$(0)
CD_Status
print Status:,@$(0)
CD_length
Print Länge der CD:,@$(0)
CD_T_number
print Anzahl Musikstücke:,@$(0)
CD_TSposition 1
Print Trackpos 1:,@$(0)
CD_TSposition 2
Print Trackpos 2:,@$(0)
CD_Tracklength 1
Print Tracklänge 1:,@$(0)
CD_PlayFromTo 2,3 oder CD_Play für die ganze CD bei track Angabe Zeitformat tmsf
CD_Ready
Print CD Device ready?:,@$(0)
CD_TSposition 2
Print Trackpos 2:,@$(0)
CD_Status
print Status:,@$(0)

whilenot equ$(status$,stopped)

    CD_Status
    let status$=@$(0)
    CD_position
    locate 12,0
    print @$(0)

wend

waitinput
CD_Stop
CD_CLOSE