XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
CD-Player
--- Windows CD Player ---
von
Jürgen Vetter
Gutenbergstraße 51
44139 Dortmund
Fido 2:243/4601.6
Version 1.00
Version 1.5 optisch aufbereitet von Roland G. Hülsmann
Version 1.6 angepaßt an XProfan von Roland G. Hülsmann
Dieses Programm wurde auf einem 486/33 MHz 8 MB
Windows 3.1
DOS 6.0
Mitsumi LU005S
getestet
Dieses Programm ist F R E E W A R E. Bei der Weitergabe dieses Programm darf keine
Gebühr erhoben werden. Es ist kostenfrei weiterzugeben. Ich übernehme keine
Verantwortung für Schäden an der Hardware oder Software bei Einsatz dieses Programms
Ich schließe auch alle anderen Pflichten aus.
Der Sourcecode darf nur mit meiner Genehmigung verändert werden.
Mein Dank geht an Roland G. Hülsmann für Profan Version 2.5
Mich würde ein Kontaktaustausch zwischen Programmieren natürlich freuen
Bitte schreibe doch eine kleine NetMail im Fido.
--------------------------------------------------------------------------------------------
*** programm endekennzeichen -> 0
declare verkz%
*** betriebsmouds -> 1 shuffle
declare modus%
*** 99 Stücke können gespeichert werden
dim$ 99
*** CD Variablen
declare cdanz%,cdanzs$,cdlaen$,cdplay$,cdtrack$,cdzw$
declare cdakt%,cdalt%,cdmin%,cdsec%,cdmalt%,cdsalt%
*** laufvariablen / zwischenvariablen
declare sub%,ende%,zw$,zahl%,mci1$,trenn$,steppos$,disp$,zufall%,nummer%,zwert%
*** Daten alle refreshen -> 1
declare datenref%,timeref$
*** Variablen auf Grund setzen
verkz%    = 1
cdakt%    = 1
cdplay$   = 01:00:00:00
datenref% = 1
trenn$    = :
modus%    = 0
color 1,15
*---------------------------*
* MCI Error eingetreten     *
*---------------------------*

proc mfehler

    @messagebox(Es ist ein Mediafehler aufgetreten!,
    Ignorieren?,33)
    case (%button = 2):verkz%   = 0

endproc

*---------------------------*
* Ermittelt die CD-Daten    *
*---------------------------*

proc cddaten

    cdanzs$  = @mcisend$(status cd number of tracks)
    cdlaen$  = @mcisend$(status cd length)
    cdanz%   = @val(cdanzs$)
    sub%     = 1
    ende%    = 1

    while ende%

        list$ sub% = @mcisend$(status cd length track  + @str$(sub%))

        if (sub% = cdanz%)

            ende% = 0

        endif

        inc sub%

    wend

endproc

*---------------------------*
* Füllt eine Box mit Daten  *
*---------------------------*

proc aufbau

    declare sub$
    clearlist
    sub%  = 1
    ende% = 1

    while ende%

        sub$=@str$(sub%)
        case (sub% < 10):sub$ = 0 + sub$
        zw$ = sub$ +  -
        addstring zw$ + @list$(sub%)

        if (sub% = cdanz%)

            ende% = 0

        endif

        inc sub%

    wend

endproc

*---------------------------*
* zeigt die CD Daten nun an *
* und ermöglicht Auswahl    *
*---------------------------*

proc cdlist

    declare wahl$
    wahl$=@ListBox$(Stück - Länge,0)

    If (wahl$ <> )

        nummer% = %getcursel + 1
        @mcisend$(play cd from  + @Str$(nummer%))

        if (%mcierror <> 0)

            mfehler

        endif

    endif

endproc

*---------------------------*
* Schirm aufbauen           *
*---------------------------*

proc schirm

    cls
    usebrush 1,0
    rectangle 0,0-420,42
    font 2
    color 14,0
    locate 1,2
    print Aktuelle Position:
    locate 1,30
    print Uhrzeit.....:
    locate 2,2
    print Anzahl Gesamt....:
    locate 2,30
    print Länge Gesamt:
    locate 3,2
    print Aktuelles Stück..:
    locate 3,30
    print Länge Stück.:
    loadsizedbmp WINLOGO.BMP,0,42-420,258;0
    color 15,8
    tbox 5,2 - 7,8;0
    print Liste
    tbox 9,2 -11,8;0
    print Ende
    color 14,2
    tbox  5,11- 7,15;0
    print  1
    tbox  5,17- 7,21;0
    print  2
    tbox  5,23- 7,27;0
    print  3
    tbox  9,11-11,15;0
    print  4
    tbox  9,17-11,21;0
    print  5
    tbox  9,23-11,27;0
    print  6
    tbox 13,11-15,15;0
    print  7
    tbox 13,17-15,21;0
    print  8
    tbox 13,23-15,27;0
    print  9
    tbox 17,11-19,15;0
    print  1*
    tbox 17,17-19,21;0
    print  0
    tbox 17,23-19,27;0
    print  2*
    color 0,13
    tbox  5,30- 7,35;0
    print  <<
    tbox  5,37- 7,42;0
    print  ->
    tbox  5,44- 7,49;0
    print  >>
    tbox  9,30-11,35;0
    print  |<
    tbox  9,37-11,42;0
    print  ##
    tbox  9,44-11,49;0
    print  >|
    tbox 13,30-15,35;0
    print  ||
    tbox 13,37-15,49;0
    print   Shuffle
    tbox 17,37-19,49;0
    print   Normal
    color 14,0

endproc

*---------------------------*
* CD-Rom nicht gefunden     *
*---------------------------*

proc mfehler2

    @messagebox(CD-Rom nicht gefunden oder wird bereits benutzt,
    Programmabbruch !,16)
    verkz% = 0

endproc

*---------------------------*
* fehlerhafte Auswahl       *
*---------------------------*

proc fehlaus

    @messagebox(Dieses Stück gibt es nicht,
    Hinweis,0)

endproc

*---------------------------*
* Programm beenden          *
*---------------------------*

proc ende

    @messagebox(Wollen Sie das Programm wirklich beenden?,
    Frage:,36)
    case @equ(%button,6):verkz% = 0

endproc

*---------------------------*
* MCI-Befehl aufbauen       *
*---------------------------*

proc mcivor

    mci1$   = @str$(cdmin%)
    mci1$   = mci1$ + trenn$
    mci1$   = mci1$ + @str$(cdsec%)
    cdplay$ = @str$(cdakt%) + trenn$
    cdplay$ = cdplay$ + mci1$

endproc

*---------------------------*
* nächstes Stück bestimmen  *
* muss noch erweitert werden*
* ausgrenzung gespielter st *
*---------------------------*

proc bestimme

    zufall% = @rnd (cdanz%)
    inc zufall%
    cdakt%  = zufall%

endproc

*---------------------------*
*  CD-Betriebsmodus         *
*---------------------------*

proc cdmodus

    if (modus% = 1)

        color 13,5
        tbox 13,37-15,49;1
        print   Shuffle
        color 0,13
        tbox 17,37-19,49;0
        print   Normal

    else

        color 0,13
        tbox 13,37-15,49;0
        print   Shuffle
        color 13,5
        tbox 17,37-19,49;1
        print   Normal

    endif

endproc

*---------------------------*
* Modus normal              *
*---------------------------*

proc cdnormal

    modus% = 0
    cdmodus

endproc

*---------------------------*
* Shuffle aktivieren        *
*---------------------------*

proc cdshuffle

    modus% = 1
    cdmodus

endproc

*---------------------------*
* alle Daten neuaufbauen    *
*---------------------------*

proc datenerw

    color 14,0
    locate 2,21
    print cdanzs$
    locate 2,44
    print cdlaen$
    locate 3,21
    print @mid$(disp$,1,2)
    locate 3,44
    print @list$(cdakt%)
    datenref% = 0
    cdalt%    = cdakt%

endproc

*---------------------------*
* Datendisplay              *
*---------------------------*

proc datendisp

    color 14,0
    locate 1,44
    print @time$(0)
    disp$  = @mcisend$(Status cd position)

    ifnot (%mcierror = 0)

        mfehler

    else

        locate 1,21
        print @mid$(disp$,4,5)

        if (datenref% = 1)

            datenerw

        endif

        cdakt% = @val(@mid$(disp$,1,2))

        if (cdakt% <> cdalt%)

            if (modus% = 1)

                bestimme

            endif

            datenerw

        endif

    endif

endproc

*---------------------------*
* CD abspielen              *
*---------------------------*

proc cdplay

    @mcisend$(play cd from  + cdplay$)

    if (%mcierror <> 0)

        mfehler

    endif

endproc

*---------------------------*
* CD ein Stück zurück       *
*---------------------------*

proc cdback

    zahl% = cdakt%
    dec zahl%

    if (zahl% > 0)

        cdakt%  = zahl%
        cdalt%  = cdakt%
        cdplay$ = @str$(cdakt%)
        cdplay
        datenref% = 1

    endif

endproc

*---------------------------*
* CD ein Stück vor          *
*---------------------------*

proc cdfor

    zahl% = cdakt%
    inc zahl%

    if (zahl% <= cdanz%)

        cdakt%  = zahl%
        cdalt%  = cdakt%
        cdplay$ = @str$(cdakt%)
        cdplay
        datenref% = 1

    endif

endproc

*---------------------------*
* CD zurück springen        *
*---------------------------*

proc cdstepb

    steppos$ = @mcisend$(status cd position)
    cdsec%   = @val(@mid$(steppos$,7,2))
    cdmin%   = @val(@mid$(steppos$,4,2))
    cdsec%   = @sub(cdsec%,15)

    if (cdsec% < 0)

        cdsec% = cdsec% + 60
        cdmin% = cdmin% - 1

        if (cdmin% >= 0)

            mcivor
            cdplay

        endif

    else

        mcivor
        cdplay

    endif

endproc

*---------------------------*
* CD stoppen                *
*---------------------------*

proc cdstop

    @MCISEND$(stop cd)

    if (%mcierror <> 0)

        mfehler

    else

        cdakt%    = 1
        cdalt%    = 1
        datenref% = 1

    endif

endproc

*---------------------------*
* CD vor springen           *
*---------------------------*

proc cdstepf

    cdzw$    = @mid$(@mcisend$(status cd length track  + @str$(cdakt%)),1,5)
    cdmalt%  = @val(@mid$(cdzw$,1,2))
    cdsalt%  = @val(@mid$(cdzw$,4,2))
    steppos$ = @mcisend$(status cd position)
    cdsec%   = @val(@mid$(steppos$,7,2))
    cdmin%   = @val(@mid$(steppos$,4,2))
    cdsec%   = cdsec% + 15

    if (cdsec% > 60)

        sub cdsec%,60
        cdmin% = cdmin% + 1

        if (cdmin% <= cdmalt%)

            if (cdsec% <= cdsalt%)

                mcivor
                cdplay

            endif

        endif

    else

        mcivor
        cdplay

    endif

endproc

*---------------------------*
* CD an Position anhalten   *
*---------------------------*

proc cdhold

    @MCISEND$(stop cd)

    if (%mcierror <> 0)

        mfehler

    else

        cdplay$ = @mcisend$(status cd position)

    endif

endproc

*---------------------------*
* 10er Block                *
*---------------------------*

proc asub1

    if @tmouse(17,11-19,15)

        locate 9,21
        color 14,2
        tbox 17,11-19,15;0
        print  1*
        tbox 17,17-19,21;0
        print  0
        tbox 17,23-19,27;0
        print  2*
        color 2,10
        tbox 17,11-19,15;1
        print  1*
        color 14,0
        nummer% = 10

    endif

    if @tmouse(17,23-19,27)

        locate 9,21
        color 14,2
        tbox 17,11-19,15;0
        print  1*
        tbox 17,17-19,21;0
        print  0
        tbox 17,23-19,27;0
        print  2*
        color 2,10
        tbox 17,23-19,27;1
        print  2*
        color 14,0
        nummer% = 20

    endif

endproc

*---------------------------*
* Stück spielen per Display *
*---------------------------*

proc asub2

    if (nummer% <= cdanz%)

        cdakt%    = nummer%
        cdalt%    = cdakt%
        cdplay$   = @str$(cdakt%)
        cdplay
        datenref% = 1

    else

        fehlaus

    endif

    color 14,2
    tbox 17,11-19,15;0
    print  1*
    tbox 17,17-19,21;0
    print  0
    tbox 17,23-19,27;0
    print  2*
    nummer% = 0

endproc

*---------------------------*
* Auswahl Nummerndisplay    *
*---------------------------*

proc auswahl

    zwert% = 999
    case @tmouse( 5,11- 7,15):zwert% = 1
    case @tmouse( 5,17- 7,21):zwert% = 2
    case @tmouse( 5,23- 7,27):zwert% = 3
    case @tmouse( 9,11-11,15):zwert% = 4
    case @tmouse( 9,17-11,21):zwert% = 5
    case @tmouse( 9,23-11,27):zwert% = 6
    case @tmouse(13,11-15,15):zwert% = 7
    case @tmouse(13,17-15,21):zwert% = 8
    case @tmouse(13,23-15,27):zwert% = 9
    case @tmouse(17,11-19,15):asub1
    case @tmouse(17,17-19,21):zwert% = 0
    case @tmouse(17,23-19,27):asub1

    if (zwert% <> 999)

        nummer% = nummer% + zwert%

        if (nummer% <> 0)

            asub2

        endif

    endif

endproc

*---------------------------*
* Hauptprogramm             *
*---------------------------*
WindowTitle PROFAN² CD-Player 1.6
windowstyle 10
window 50,50-420,320
Cls
locate 9,8
print Der CD-Player wird initialisiert ...
@mcisend$(open cdaudio alias cd)

ifnot @equ(%mcierror,0)

    mfehler2
    case @equ(verkz%,0):end

endif

@mcisend$(set cd time format tmsf)
cddaten
aufbau
schirm
cdmodus
datendisp

while verkz%

    if @equ(%mousekey,1)

        if @tmouse( 5, 2- 7, 8)

            cdlist

        endif

        case @tmouse( 9, 2-11, 8):ende
        case @tmouse( 5,11-19,27):auswahl
        case @tmouse( 5,30- 7,35):cdback
        case @tmouse( 5,37- 7,42):cdplay
        case @tmouse( 5,44- 7,49):cdfor
        case @tmouse( 9,30-11,35):cdstepb
        case @tmouse( 9,37-11,42):cdstop
        case @tmouse( 9,44-11,49):cdstepf
        case @tmouse(13,30-15,35):cdhold
        case @tmouse(13,43-15,49):cdshuffle
        cas @tmouse(17,43-19,49):cdnormal

    d'autre

        datendisp

    endif

Wend

end