XProfan

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

Proc Midi_Open

    Parameters MidiFile$

    If @NEq$(MidiFile$,)

        @MCISend$(OPEN +@Chr$(34)+MidiFile$+@Chr$(34)+ TYPE SEQUENCER ALIAS Midi_play)
        @MCISend$(set Midi_play time format ms)

    EndIf

EndProc

Proc Midi_Stop

    @MCISend$(STOP Midi_play)
    @MCISend$(CLOSE Midi_play)

EndProc

Proc Midi_Close

    @MCISend$(CLOSE Midi_play)

EndProc

proc Midi_Error

    if %mcierror

        declare tz$,mess$
        let tz$=Device Error
        let mess$=Sorry, The Player can´t play this File
        @messagebox(mess$,tz$,48)
        Midi_Stop
        Midi_Close
        let Midierror&=1
        return Midierror&

    endif

    let Midierror&=0
    return Midierror&

endproc

Proc Midi_Play

    @MCISend$(PLAY Midi_play)

EndProc

Proc Midi_PlayLoop

    @MCISend$(PLAY Midi_play LOOP)

EndProc

Proc Midi_PlayFromTO

    parameters from$,to$
    @MCISend$(PLAY Midi_play FROM +from$+ TO +To$)  Spielt von Track bis Track mit Parameter from& to&

EndProc

Proc Midi_SeekToEnd

    @MCISend$(SEEK Midi_play TO END) Sucht Vorwärts bis zum Ende

EndProc

Proc Midi_SeekToStart

    @MCISend$(SEEK Midi_play TO START) Sucht Rückwärts bis zum Anfang

EndProc

Proc Midi_SeekTO

    Parameters pos$
    @MCISend$(SEEK Midi_play TO +pos$) Sucht bis zur Position

EndProc

Proc Midi_Pause

    @MCISend$(PAUSE Midi_play)

EndProc

Proc Midi_PlayMode

    Declare Midi_Result$
    Let Midi_Result$=@MCISend$(STATUS Midi_play MODE)zeigt den Zustand (stopped, playing, paused, not ready)
    Return Midi_Result$

EndProc

Proc Midi_length LengthMidi weiter unten benutzen für Umrechnung

    Declare Midi_Result$
    Let Midi_Result$=@MCISend$(STATUS Midi_play LENGTH) Länge der Midi
    Return Midi_Result$

Endproc

Proc Midi_position posMidi weiter unten benutzen für Umrechnung

    Declare Midi_Result$
    Let Midi_Result$=@MCISend$(STATUS Midi_play POSITION) aktuelle Position
    Return Midi_Result$

Endproc

Proc MidiTempo

    parameters tempo$
    Let Midi_Result$=@MCISend$(SET Midi_play TEMPO +tempo$)
    set clavier tempo 170

endproc

Proc LengthMidi rechnet in Minuten Sekunden der String 00:00

    declare lang&,sek%,wert$,lang$,temp$
    Midi_length
    Let lang&=@Val(@&(0))
    let sek%=@div&(lang&,1000)
    let lang&=@div&(sek%,60)
    let temp$=add$(str$(lang&),:)

    If @equ(@len(temp$),2)

        let wert$=@add$(0,temp$)

    else

        let wert$=temp$

    endif

    let sek%=@sub(sek%,@mul(lang&,60))

    If @lt(sek%,10)

        let wert$=@add$(wert$,0)
        let wert$=@add$(wert$,@str$(sek%))

    else

        let wert$=@add$(wert$,@str$(sek%))

    endif

    Return wert$

EndProc

Proc PosMidi rechnet in Minuten Sekunden der String 00:00

    declare lang&,sek%,wert$,lang$,temp$
    let wert$=00:00
    Midi_position
    let lang&=@Val(@&(0))
    let sek%=@div&(lang&,1000)
    let lang&=@div&(sek%,60)
    let temp$=add$(str$(lang&),:)

    If @equ(@len(temp$),2)

        let wert$=@add$(0,temp$)

    else

        let wert$=temp$

    endif

    let sek%=@sub(sek%,@mul(lang&,60))

    If @lt(sek%,10)

        let wert$=@add$(wert$,0)
        let wert$=@add$(wert$,@str$(sek%))

    else

        let wert$=@add$(wert$,@str$(sek%))

    endif

    Return wert$

Endproc

beispiel
cls
Midi_open C:WINDOWSMEDIATOWN.MID
Midi_open MIDI_01.MID
LengthMidi
print @$(0)
Midi_PlayMode
Print Playmode:,@$(0)
Midi_Play
Midi_PlayMode
Print Playmode:,@$(0)
Print klick für Pause
waitinput
Midi_Pause
Midi_PlayMode
Print Playmode:,@$(0)
Print klick für weiter und Positon
waitinput
Midi_Play
Midi_PlayMode
Print Playmode:,@$(0)
PosMidi  In schleife abfragen
print @$(0)
../../Function-References/XProfan/waitinput/'>waitinput
Midi_Stop
Midi_Close