Below you'll find the source for the QBasic file PLAYER.BAS.
I've been in doubt if I'd republish this file again. Mainly for a few reasons;
1. The stuff I made as a kid is very childish (which kinda makes sense)
2. Times have changed; what was funny/innovative or sharable in 1997 doesn't meet standards in 2024.
3. Most of the code doesn't run natively anymore on modern operating systems.
4. It's in the Dutch language, where most of my shared content is in English.
Still, I've decided to share this file. Keep in mind the age of this content though.
' Druk op Shift+F5 voor mooie muziek!
'
'┌┬───Ì────────██─┬─────Ì────────██──┬┐
'├┼▄──Ì──Ì──██─¦──┼─────Ì──Ì═─██─¦──▄┼┤
'├┼──██──Ì──¦──¦──┼─▀▀─██──Ì──¦──¦───┼┤
'├┼▀────██──¦─────┼───────██─═¦─────▀┼┤
'└┴───────────────┴──────────────────┴┘
'
'
'
'
'
'
'
'
'
'
'
DECLARE SUB AndereTitel ()
DECLARE SUB ASCII ()
DECLARE SUB Beeld (x!, t$)
DECLARE SUB EVenster (bx!, by!, ex!, ey!, d3!)
DECLARE SUB FileInfo (FSp$, Nm$, FSz&, yr%, mon%, dy%, hr%, min%, sec%, Attr$)
DECLARE SUB HoofdScherm ()
DECLARE SUB Info ()
DECLARE SUB Lijn (bx!, by!, ey!)
DECLARE SUB Loopje (t$, k%, x%, y%, t%)
DECLARE SUB MaakBAS ()
DECLARE SUB Menu (Reactie!)
DECLARE SUB Muis (a%, b%, c%, d%)
DECLARE SUB MUS2BAS (Bas$, Mus$, Regelnrs!, Repeat!)
DECLARE SUB Openen ()
DECLARE SUB Speel ()
DECLARE SUB Venster (bx!, by!, ex!, ey!)
DECLARE SUB Versnel ()
DECLARE SUB Vertraag ()
DECLARE FUNCTION Bestandslengte! (f$)
DECLARE FUNCTION Toets% ()
DECLARE FUNCTION ZoekMuis% ()
COMMON SHARED MuisStatus%, Bestand$, bk, BestandSoort, RepeatMus
TYPE RegType
AX AS INTEGER
bx AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
TYPE FileData
Unused AS STRING * 21
Attr AS STRING * 1
Time AS INTEGER
Date AS INTEGER
FileSize AS LONG
FileName AS STRING * 13
END TYPE
IF ZoekMuis THEN MuisAanwezig% = -1 ELSE : MuisAanwezig% = 0
MuisStatus% = MuisAanwezig%
CONST Okee = -1, Geen = 0, KlikBestand = 1, KlikUtilities = 2, MusF = 3
CONST KarF = 4, AscF = 5, Alt = 8
ON ERROR GOTO FoutMelding
Com$ = COMMAND$ 'Dit werkt alleen in QuickBasic
'Zet er REM voor als het niet werkt
IF Com$ = "/?" THEN
SHELL "cd > player.tmp"
OPEN "player.tmp" FOR INPUT AS #1: LINE INPUT #1, a$: CLOSE #1
KILL "player.tmp"
a$ = UCASE$(a$)
PRINT "Music Player V3.0 is ontworpen door Stefan Thoolen"
PRINT "Als u dit laat registreren (gratis) wordt u op de hoogte gehouden"
PRINT "van nieuwe muziekjes en/of niewe versies voor dit programma"
PRINT "Om het registratieformulier te printen typ PLAYER /R"
PRINT "Typ PLAYER /A voor het adres van de maker (voor vragen en/of opmerkingen)"
PRINT "Wat is er nieuwer vergeleken met V2.0?"
PRINT "Deze kent ook ASC-bestanden en er zit een extra compiler bij"
PRINT
IF LEFT$(a$, 1) = "A" OR LEFT$(a$, 1) = "B" THEN PRINT "Ps. dit programma werkt vanaf harde schijf sneller"
SYSTEM
END IF
IF Com$ = "/R" THEN
LPRINT " Music Player V3.0"; STRING$(17, 8); STRING$(17, "_")
LPRINT
LPRINT "Naam : ___________________________"
LPRINT "Adres : ___________________________"
LPRINT "Postcode+Woonplaats: ___________________________"
LPRINT
LPRINT "Als u de volgende gegevens goed invult, werkt dat in uw voordeel"; CHR$(13)
LPRINT "Kruis de dingen die van toepassing zijn aan:"
LPRINT "O Ik wil graag op de hoogte blijven van de nieuwste versie van Music Player"
LPRINT "O Ik wil graag op de hoogte blijven van de nieuwste muziekjes"
LPRINT
LPRINT "O Ik ben tussen de 0 en 12 jaar oud"
LPRINT "O Ik ben tussen de 13 en 20 jaar oud"
LPRINT "O Ik ben tussen de 21 en 50 jaar oud"
LPRINT "O Ik ben ouder als 50 jaar oud"
LPRINT
LPRINT "Van deze muzieksoort houd ik het meeste: ______________________"
LPRINT
LPRINT "Doorstrepen wat niet van toepassing is"
LPRINT "Ik programmeer wel/niet in ____________"
PRINT "Nu is de computer bezig met printen"
PRINT "Vul dit papier in en stuur naar:"; CHR$(13)
Com$ = "/A"
END IF
IF Com$ = "/A" THEN
PRINT "Stefan Thoolen"
PRINT "-Address removed-"
PRINT "48** ** Breda"
PRINT "Nederland"
SYSTEM
END IF
IF Com$ <> "" THEN
OPEN Com$ FOR INPUT AS #1
LINE INPUT #1, a$
DO UNTIL EOF(1)
LINE INPUT #1, a$
a$ = LTRIM$(UCASE$(RTRIM$(a$)))
IF LEFT$(a$, 1) <> "'" THEN PLAY a$
IF INKEY$ <> "" THEN SYSTEM
LOOP
CLOSE #1
SYSTEM
END IF
Bestand$ = "GEENNAAM.MUS"
Muis 1, 0, 0, 0
Muis 4, 0, 0, 0
bk = 0
DO
HoofdScherm
Terug:
Loopje a$, k%, x%, y%, t%
IF a$ = CHR$(18) THEN
Reactie = RepeatMus
IF RepeatMus THEN RepeatMus = 0 ELSE RepeatMus = -1
HoofdScherm
END IF
IF a$ = CHR$(0) + "?" THEN a$ = CHR$(0) + "X"
IF a$ = CHR$(0) + "X" THEN Speel: HoofdScherm
Reactie = Geen
IF t% = Alt THEN Reactie = Alt
IF k% = 1 AND x% = 1 AND y% > 2 AND y% < 12 THEN Reactie = KlikBestand
IF k% = 1 AND x% = 1 AND y% > 11 AND y% < 23 THEN Reactie = KlikUtilities
IF Reactie <> Geen THEN Menu Reactie ELSE GOTO Terug
LOOP
FoutMelding:
SCREEN 0
WIDTH 80, 25
COLOR 7, 0
CLS
PRINT "Fout nummer"; ERR; "gevonden"
SYSTEM
SUB AndereTitel
IF NOT bk THEN BEEP: EXIT SUB
IF BestandSoort = AscF THEN BEEP: EXIT SUB
HoofdScherm
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Venster 11, 5, 13, 75
COLOR 1
Beeld 11, "Titel " + Bestand$ + " veranderen"
COLOR 0
OPEN Bestand$ FOR INPUT AS #1: LINE INPUT #1, Tit$: CLOSE #1
IF LEN(Tit$) > 60 THEN Tit$ = LEFT$(Tit$, LEN(Tit$) - 60)
Muis 4, 0, y%, x%
DO
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 0, 15
IF LEN(Tit$) > 60 THEN Tit$ = LEFT$(Tit$, 60)
LOCATE 12, 7: PRINT "Titel: "; Tit$;
COLOR 16: PRINT "_ ";
Muis 4, 0, y%, x%
Loopje a$, k%, y%, x%, t%
IF a$ = CHR$(8) THEN
a$ = ""
IF LEN(Tit$) > 0 THEN Tit$ = LEFT$(Tit$, LEN(Tit$) - 1)
END IF
IF a$ = CHR$(7) THEN BEEP: a$ = ""
IF LEFT$(a$, 1) = CHR$(0) THEN BEEP: a$ = ""
IF a$ = CHR$(27) THEN EXIT SUB
IF a$ <> CHR$(13) THEN Tit$ = Tit$ + a$
LOOP WHILE a$ <> CHR$(13)
SHELL "COPY " + Bestand$ + " PLAYER.TMP > NUL"
OPEN "PLAYER.TMP" FOR INPUT AS #1
OPEN Bestand$ FOR OUTPUT AS #2
LINE INPUT #1, a$
PRINT #2, Tit$
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF a$ <> "" THEN PRINT #2, a$
LOOP
CLOSE #2
CLOSE #1
KILL "PLAYER.TMP"
END SUB
SUB ASCII
IF NOT bk THEN BEEP: EXIT SUB
HoofdScherm
Naam$ = LEFT$(Bestand$, INSTR(Bestand$, ".") - 1)
IF BestandSoort = AscF THEN
OPEN Bestand$ FOR INPUT AS #1
OPEN Naam$ + ".MUS" FOR OUTPUT AS #2
PRINT #2, Bestand$; " omgezet naar "; Naam$; ".MUS"
DO UNTIL EOF(1)
LINE INPUT #1, a$
PRINT #2, a$
LOOP
CLOSE #2
CLOSE #1
ResBes$ = Bestand$
ResSrt = BestandSoort
Bestand$ = Naam$ + ".MUS"
BestandSoort = MusF
AndereTitel
Bestand$ = ResBes$
BestandSoort = ResSrt
ELSE
OPEN Bestand$ FOR INPUT AS #1
OPEN Naam$ + ".ASC" FOR OUTPUT AS #2
LINE INPUT #1, a$
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF BestandSoort = KarF THEN LINE INPUT #1, b$
PRINT #2, a$
LOOP
CLOSE #2
CLOSE #1
END IF
Muis 3, 0, y%, x%
Muis 4, 0, 0, 0
Venster 10, 3, 14, 77
Beeld 11, "Bestand is omgezet"
COLOR 16
Beeld 13, "Druk op een toets"
Muis 4, 0, y%, x%
Loopje t$, k%, x%, y%, t%
END SUB
SUB Beeld (x, t$)
LOCATE x, 40 - LEN(t$) / 2: PRINT t$;
END SUB
SUB EVenster (bx, by, ex, ey, d3)
DIM Klr(3)
IF d3 = 1 THEN Klr(1) = 8: Klr(2) = 15
IF d3 = 2 THEN Klr(1) = 15: Klr(2) = 8
Klr(3) = 7
COLOR Klr(1), Klr(3)
LOCATE bx, by: PRINT "┌"; STRING$(ey - by - 1, 196);
COLOR Klr(2)
PRINT "┐";
FOR Tel = bx + 1 TO ex - 1
COLOR Klr(1)
LOCATE Tel, by: PRINT "│";
COLOR Klr(2): PRINT SPACE$(ey - by - 1); "│";
NEXT Tel
COLOR Klr(1)
LOCATE ex, by: PRINT "└";
COLOR Klr(2)
PRINT STRING$(ey - by - 1, 196); "┘";
END SUB
SUB FileInfo (FSp$, Nm$, FSz&, yr%, mon%, dy%, hr%, min%, sec%, Attr$)
DIM InputRegs AS RegType, OutputRegs AS RegType
DIM DTA AS FileData
InputRegs.DX = VARPTR(DTA)
InputRegs.AX = &H1A00 'In QBasic werkt dit niet
'Daarom is er PLAYER.EXE
CALL INTERRUPT(&H21, InputRegs, OutputRegs) 'Om dit in QuickBasic te kunnen
FSpCopy$ = FSp$ + CHR$(0) 'laten draaien moet je QB /L
InputRegs.DX = SADD(FSpCopy$) 'intypen. Overigens, mooi
InputRegs.CX = &H16 'programma hé?
InputRegs.AX = &H4E00
CALL INTERRUPT(&H21, InputRegs, OutputRegs)
IF (OutputRegs.AX AND &HFF) <> 0 THEN
FSz& = -1
EXIT SUB
END IF
FSz& = DTA.FileSize
yr% = (DTA.Date AND &H7FFF) \ 512 + 80
IF DTA.Date < 0 THEN yr% = yr% + 64
IF yr% > 99 THEN yr% = yr% - 100
mon% = ((DTA.Date AND &H7FFF) \ 32) AND &HF
dy% = DTA.Date AND &H1F
hr% = (DTA.Time AND &H7FFF) \ 2048
IF DTA.Time < 0 THEN hr% = hr% + 16
min% = ((DTA.Time AND &H7FFF) \ 32) AND &H3F
sec% = (DTA.Time AND &H1F) * 2
Nm$ = DTA.FileName
J% = INSTR(Nm$, CHR$(0))
Nm$ = LEFT$(Nm$, J% - 1)
Attr$ = STRING$(6, 32)
IF (ASC(DTA.Attr) AND &H20) <> 0 THEN MID$(Attr$, 1, 1) = "A"
IF (ASC(DTA.Attr) AND &H10) <> 0 THEN MID$(Attr$, 2, 1) = "D"
IF (ASC(DTA.Attr) AND &H2) <> 0 THEN MID$(Attr$, 3, 1) = "H"
IF (ASC(DTA.Attr) AND &H1) <> 0 THEN MID$(Attr$, 4, 1) = "R"
IF (ASC(DTA.Attr) AND &H4) <> 0 THEN MID$(Attr$, 5, 1) = "S"
IF (ASC(DTA.Attr) AND &H8) <> 0 THEN MID$(Attr$, 6, 1) = "V"
END SUB
SUB HoofdScherm
LOCATE 1, 1
SCREEN 0
COLOR 7, 0, 0
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 0, 15
PRINT SPACE$(80);
LOCATE 1, 3: PRINT " Bestand "
LOCATE 1, 12: PRINT " Utilities "
COLOR 7, 1
LOCATE 2, 1: PRINT "┌"; STRING$(78, 196); "┐";
FOR a = 3 TO 23
COLOR 7, 1
LOCATE a, 1: PRINT "│"; SPACE$(78);
COLOR 0, 15
PRINT "░";
NEXT a
LOCATE 3, 80: PRINT CHR$(24);
LOCATE 23, 80: PRINT CHR$(25);
COLOR 7, 1
LOCATE 24, 1: PRINT "│";
COLOR 0, 15
PRINT CHR$(27); STRING$(76, 176); CHR$(26);
COLOR 7, 1: PRINT "│";
COLOR 1, 15: Beeld 2, " " + Bestand$ + " "
COLOR 7, 1
IF bk THEN
OPEN Bestand$ FOR INPUT AS #1
IF BestandSoort <> AscF THEN LINE INPUT #1, a$
Tel = 0
DO UNTIL EOF(1)
Tel = Tel + 1
LINE INPUT #1, a$
IF BestandSoort = KarF THEN LINE INPUT #1, a$
IF LEN(a$) > 78 THEN a$ = LEFT$(a$, 78)
LOCATE Tel + 2, 2: PRINT a$;
IF Tel = 21 THEN GOTO Regel1InSubHoofdScherm
LOOP
Regel1InSubHoofdScherm:
CLOSE #1
END IF
Muis 4, 0, y%, x%
COLOR 0, 3
LOCATE 25, 1: PRINT " Music Player V3.0 Druk op Alt voor de menubalk │ ";
IF RepeatMus THEN PRINT "R"; ELSE PRINT " ";
COLOR 7, 0
END SUB
SUB Info
IF NOT bk THEN BEEP: EXIT SUB
HoofdScherm
FSp$ = Bestand$
FileInfo FSp$, Nm$, FSz&, yr%, mon%, dy%, hr%, min%, sec%, Attr$
dy$ = LTRIM$(STR$(dy%)): mon$ = LTRIM$(STR$(mon%)): yr$ = LTRIM$(STR$(yr%))
dy$ = STRING$(2 - LEN(dy$), "0") + dy$: mon$ = STRING$(2 - LEN(mon$), "0") + mon$: yr$ = STRING$(2 - LEN(yr$), "0") + yr$
hr$ = LTRIM$(STR$(hr%)): min$ = LTRIM$(STR$(min%)): sec$ = LTRIM$(STR$(sec%))
hr$ = STRING$(2 - LEN(hr$), "0") + hr$: min$ = STRING$(2 - LEN(min$), "0") + min$: sec$ = STRING$(2 - LEN(sec$), "0") + sec$
Datum$ = dy$ + "-" + mon$ + "-" + yr$ 'Datum laatste wijziging
Tijd$ = hr$ + ":" + min$ + ":" + sec$ 'Tijd laatste wijziging
Naam$ = Nm$ + SPACE$(12 - LEN(Nm$)) 'Bestandsnaam
Bytes& = FSz& 'Aantal bytes
Attribuut$ = Attr$ 'Attributen
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Venster 9, 5, 17, 75
OPEN Bestand$ FOR INPUT AS #1: LINE INPUT #1, Titel$: CLOSE #1
Titel$ = LEFT$(Titel$, 60)
IF BestandSoort = MusF THEN Typen$ = "Muziekbestand"
IF BestandSoort = KarF THEN Typen$ = "Karaokebestand"
Beeld 9, " Informatie van " + RTRIM$(Naam$) + " "
Beeld 10, "Titel " + Titel$
Beeld 11, "Aangemaakt op " + Datum$
Beeld 12, "Aangemaakt om " + Tijd$
Beeld 13, "Aantal bytes " + STR$(Bytes&)
Beeld 14, "Attributen " + Attribuut$
Beeld 15, "Bestandstype " + Typen$
COLOR 16
Beeld 16, "Druk op een toets"
Muis 4, 0, y%, x%
Loopje a$, k%, x%, y%, t%
END SUB
SUB Lijn (bx, by, ey)
COLOR 0, 15
LOCATE bx, by: PRINT "├"; STRING$(ey - by - 1, 196); "┤";
END SUB
SUB Loopje (t$, k%, x%, y%, t%)
COLOR 0, 3
xp = CSRLIN: yp = POS(1)
FOR a = 1 TO 80: LOCATE 25, a: PRINT CHR$(SCREEN(25, a)); : NEXT a
x$ = STRING$(5, "0")
y$ = STRING$(3, "0")
DO
t$ = INKEY$
t% = Toets%
Muis 3, k%, y%, x%
y% = CINT(y% / 8 + 1)
x% = CINT(x% / 8 + 1)
x$ = LTRIM$(STR$(x%))
y$ = LTRIM$(STR$(y%))
x$ = STRING$(5 - LEN(x$), "0") + x$
y$ = STRING$(3 - LEN(y$), "0") + y$
LOCATE 25, 71: PRINT x$; ":"; y$;
LOCATE xp, yp
LOOP WHILE t$ = "" AND k% = 0 AND t% = 0
END SUB
SUB MaakBAS
IF NOT bk THEN BEEP: EXIT SUB
Mus$ = Bestand$
a = INSTR(Mus$, ".")
IF a = 0 THEN Mus$ = Mus$ + "."
a = INSTR(Mus$, ".")
Bas$ = LEFT$(Mus$, a - 1) + ".BAS"
Sts$ = LEFT$(Mus$, a - 1) + ".STS"
HoofdScherm
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Venster 10, 20, 15, 60
Regelnrs = -1: Repeat = RepeatMus
LOCATE 11, 22
IF BestandSoort = MusF THEN PRINT "MUS";
IF BestandSoort = AscF THEN PRINT "ASC";
IF BestandSoort = KarF THEN PRINT "KAR";
PRINT "-bestand: "; Mus$
LOCATE 12, 22: PRINT "BAS-bestand: "; Bas$
LOCATE 13, 22: PRINT "[ ] Regelnummers toevoegen"
LOCATE 14, 22: PRINT "[ ] Nummer herhalen"
LOCATE 13, 23
IF Regelnrs THEN PRINT "X" ELSE PRINT " "
LOCATE 14, 23
IF Repeat THEN PRINT "X" ELSE PRINT " "
Muis 4, 0, y%, x%
DO
Loopje a$, k%, x%, y%, t%
COLOR 0, 7
IF a$ = " " THEN k% = 1: x% = 13: y% = 23
IF a$ = CHR$(9) THEN k% = 1: x% = 14: y% = 23
IF k% = 1 AND x% = 13 AND y% > 21 AND y% < 59 THEN
IF Regelnrs THEN Regelnrs = 0 ELSE Regelnrs = -1
DO: Muis 3, k%, y%, x%: LOOP WHILE k% = 1
END IF
IF k% = 1 AND x% = 14 AND y% > 21 AND y% < 59 THEN
IF Repeat THEN Repeat = 0 ELSE Repeat = -1
DO: Muis 3, k%, y%, x%: LOOP WHILE k% = 1
END IF
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
LOCATE 13, 23
IF Regelnrs THEN PRINT "X" ELSE PRINT " "
LOCATE 14, 23
IF Repeat THEN PRINT "X" ELSE PRINT " "
Muis 4, 0, y%, x%
LOOP WHILE a$ <> CHR$(13)
COLOR 16, 15
LOCATE 14, 22: PRINT "Bezig met omzetten "
OPEN Mus$ FOR INPUT AS #1
OPEN Sts$ FOR OUTPUT AS #2
IF BestandSoort = MusF THEN LINE INPUT #1, a$
IF BestandSoort = KarF THEN LINE INPUT #1, a$
IF BestandSoort = AscF THEN a$ = Bestand$
a$ = LTRIM$(RTRIM$(a$))
PRINT #2, a$
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF BestandSoort = KarF THEN LINE INPUT #1, b$
PRINT #2, a$
LOOP
CLOSE #2
CLOSE #1
IF Repeat = -1 THEN Repeat = 1
IF Regelnrs = -1 THEN Regelnrs = 1
Codes$ = LTRIM$(STR$(Repeat)) + LTRIM$(STR$(Regelnrs)) + Sts$
SHELL "STS2BAS NOSCREEN " + Codes$
END SUB
SUB Menu (Reactie)
IF Reactie = Alt THEN GOTO Regel1InSubMenu
IF Reactie = KlikBestand THEN GOTO Regel3InSubMenu
IF Reactie = KlikUtilities THEN GOTO Regel4InSubMenu
EXIT SUB
Regel1InSubMenu:
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 15, 0: LOCATE 1, 3: PRINT " B";
COLOR 7: PRINT "estand "
COLOR 15, 15: LOCATE 1, 12: PRINT " U";
COLOR 0, 15: PRINT "tilities ";
Muis 4, 0, y%, x%
Reactie = Okee
DO
Loopje a$, k%, x%, y%, t%
SELECT CASE UCASE$(a$)
CASE "U", CHR$(0) + "K", CHR$(0) + "M": Reactie = KlikUtilities
CASE CHR$(27): Reactie = Geen
CASE CHR$(13): GOTO Regel3InSubMenu
END SELECT
IF k% = 1 AND x% = 1 AND y% > 11 AND y% < 23 THEN Reactie = KlikUtilities
LOOP WHILE Reactie = Okee
IF Reactie = KlikUtilities THEN GOTO Regel2InSubMenu
EXIT SUB
Regel2InSubMenu:
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 15, 0: LOCATE 1, 12: PRINT " U";
COLOR 7: PRINT "tilities "
COLOR 15, 15: LOCATE 1, 3: PRINT " B";
COLOR 0, 15: PRINT "estand ";
Muis 4, 0, y%, x%
Reactie = Okee
DO
Loopje a$, k%, x%, y%, t%
SELECT CASE UCASE$(a$)
CASE "B", CHR$(0) + "K", CHR$(0) + "M": Reactie = KlikBestand
CASE CHR$(27): Reactie = Geen
CASE CHR$(13): GOTO Regel4InSubMenu
END SELECT
IF k% = 1 AND x% = 1 AND y% > 2 AND y% < 12 THEN Reactie = KlikBestand
LOOP WHILE Reactie = Okee
IF Reactie = KlikBestand THEN GOTO Regel1InSubMenu
EXIT SUB
Regel3InSubMenu:
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Venster 2, 2, 7, 21
COLOR 15: LOCATE 3, 4: PRINT "O";
COLOR 0: PRINT "penen"
COLOR 15: LOCATE 4, 4: PRINT "T";
COLOR 0: PRINT "itel veranderen"
COLOR 15: LOCATE 5, 4: PRINT "M";
COLOR 0: PRINT "usic Editor"
COLOR 15: LOCATE 6, 4: PRINT "A";
COLOR 0: PRINT "fsluiten"
Muis 4, 0, y%, x%
z = 1
DO
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 15, 0
LOCATE z + 2, 3: PRINT " "; CHR$(SCREEN(z + 2, 4));
COLOR 7
FOR a = 5 TO 20
LOCATE z + 2, a: PRINT CHR$(SCREEN(z + 2, a));
NEXT a
FOR b = 1 TO 4
IF b <> z THEN
COLOR 15, 15
LOCATE b + 2, 3: PRINT " "; CHR$(SCREEN(b + 2, 4));
COLOR 0
FOR a = 5 TO 20
LOCATE b + 2, a: PRINT CHR$(SCREEN(b + 2, a));
NEXT a
END IF
NEXT b
Muis 4, 0, y%, x%
Loopje a$, k%, x%, y%, t%
IF k% = 1 AND y% > 2 AND y% < 21 THEN
IF x% > 2 AND x% < 7 THEN
z = x% - 2
a$ = CHR$(13)
END IF
END IF
IF UCASE$(a$) = "O" THEN z = 1: a$ = CHR$(13)
IF UCASE$(a$) = "T" THEN z = 2: a$ = CHR$(13)
IF UCASE$(a$) = "A" THEN z = 3: a$ = CHR$(13)
SELECT CASE a$
CASE CHR$(27): EXIT SUB
CASE CHR$(0) + "P"
z = z + 1
IF z = 5 THEN z = 1
CASE CHR$(0) + "H"
z = z - 1
IF z = 0 THEN z = 4
CASE CHR$(13)
IF z = 1 THEN Openen: EXIT SUB
IF z = 2 THEN AndereTitel: EXIT SUB
IF z = 3 THEN
Muis 2, 0, 0, 0
SHELL "MAAKMUS.EXE"
SCREEN 0
Muis 1, 0, 0, 0
HoofdScherm
EXIT SUB
END IF
IF z = 4 THEN
Muis 2, 0, 0, 0
COLOR 7, 0
CLS
SHELL "cd > player.tmp"
OPEN "player.tmp" FOR INPUT AS #1: LINE INPUT #1, a$: CLOSE #1
KILL "player.tmp"
a$ = UCASE$(a$)
EVenster 1, 1, 11, 80, 2
EVenster 8, 3, 10, 78, 1
COLOR 0
LOCATE 2, 3: PRINT "Music Player V3.0 is ontworpen door Stefan Thoolen"
LOCATE 3, 3: PRINT "Als u dit laat registreren (gratis) wordt u op de hoogte gehouden"
LOCATE 4, 3: PRINT "van nieuwe muziekjes en/of niewe versies voor dit programma"
LOCATE 5, 3: PRINT "Om het registratieformulier te printen typ PLAYER /R"
LOCATE 6, 3: PRINT "Typ PLAYER /? voor meer informatie"
LOCATE 7, 3: PRINT "Je mag dit aan iedereen vrij kopieëren"
LOCATE 9, 5: PRINT "Groetjes Stefan Thoolen"
COLOR 7, 0
LOCATE 11, 1
IF LEFT$(a$, 1) = "A" OR LEFT$(a$, 1) = "B" THEN PRINT "Ps. dit programma werkt vanaf harde schijf sneller"
SYSTEM
END IF
END SELECT
LOOP
Regel4InSubMenu:
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Venster 2, 11, 8, 22
COLOR 15: LOCATE 3, 13: PRINT "N";
COLOR 0: PRINT "aar BAS"
COLOR 15: LOCATE 4, 13: PRINT "A";
COLOR 0: PRINT "fspelen"
COLOR 15: LOCATE 5, 13: PRINT "I";
COLOR 0: PRINT "nfo"
COLOR 15: LOCATE 6, 13: PRINT "R";
COLOR 0: PRINT "epeat"
COLOR 15: LOCATE 7, 13: PRINT "M";
COLOR 0: PRINT "aak ";
IF BestandSoort = MusF OR BestandSoort = KarF THEN PRINT "ASC" ELSE PRINT "MUS"
Muis 4, 0, y%, x%
z = 1
DO
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 15, 0
LOCATE z + 2, 12: PRINT " "; CHR$(SCREEN(z + 2, 13));
COLOR 7
FOR a = 14 TO 21
LOCATE z + 2, a: PRINT CHR$(SCREEN(z + 2, a));
NEXT a
FOR b = 1 TO 5
IF b <> z THEN
COLOR 15, 15
LOCATE b + 2, 12: PRINT " "; CHR$(SCREEN(b + 2, 13));
COLOR 0
FOR a = 14 TO 21
LOCATE b + 2, a: PRINT CHR$(SCREEN(b + 2, a));
NEXT a
END IF
NEXT b
Muis 4, 0, y%, x%
Loopje a$, k%, x%, y%, t%
IF k% = 1 AND y% > 11 AND y% < 22 THEN
IF x% > 2 AND x% < 8 THEN
z = x% - 2
a$ = CHR$(13)
END IF
END IF
IF UCASE$(a$) = "N" THEN z = 1: a$ = CHR$(13)
IF UCASE$(a$) = "A" THEN z = 2: a$ = CHR$(13)
IF UCASE$(a$) = "I" THEN z = 3: a$ = CHR$(13)
IF UCASE$(a$) = "R" THEN z = 4: a$ = CHR$(13)
IF UCASE$(a$) = "M" THEN z = 5: a$ = CHR$(13)
SELECT CASE a$
CASE CHR$(27): EXIT SUB
CASE CHR$(0) + "P"
z = z + 1
IF z = 6 THEN z = 1
CASE CHR$(0) + "H"
z = z - 1
IF z = 0 THEN z = 5
CASE CHR$(13)
IF z = 1 THEN MaakBAS: EXIT SUB
IF z = 2 THEN Speel: EXIT SUB
IF z = 3 THEN Info: EXIT SUB
IF z = 4 THEN
IF RepeatMus THEN RepeatMus = 0 ELSE RepeatMus = -1
EXIT SUB
END IF
IF z = 5 THEN ASCII: EXIT SUB
END SELECT
LOOP
END SUB
SUB Muis (a%, b%, c%, d%)
IF MuisStatus% THEN
DEF SEG = 0
MouseSeg% = PEEK(51 * 4 + 2) + 256 * PEEK(51 * 4 + 3)
MouseCode% = PEEK(51 * 4) + 256 * PEEK(51 * 4 + 1) + 2
DEF SEG = MouseSeg%
CALL ABSOLUTE(a%, b%, c%, d%, MouseCode%)
END IF
END SUB
SUB Openen
HoofdScherm
LOCATE 1, 1
t = 0
SHELL "DIR *.MUS > PLAYER.$$$"
SHELL "DIR *.KAR >> PLAYER.$$$"
SHELL "DIR *.ASC >> PLAYER.$$$"
HoofdScherm
OPEN "PLAYER.$$$" FOR INPUT AS #1
OPEN "PLAYER.!!!" FOR OUTPUT AS #2
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF a$ <> "" AND LEFT$(a$, 1) <> " " THEN
t$ = LEFT$(a$, 12)
a = INSTR(t$, " ")
MID$(t$, a, 1) = "."
f$ = ""
FOR a = 1 TO LEN(t$)
g$ = MID$(t$, a, 1)
IF g$ <> " " THEN f$ = f$ + g$
NEXT a
OPEN f$ FOR INPUT AS #3
LINE INPUT #3, t$
CLOSE #3
f$ = SPACE$(12 - LEN(f$)) + f$
tempje$ = RIGHT$(f$, 4)
IF tempje$ = ".ASC" THEN t$ = f$
PRINT #2, f$; t$: t = t + 1
END IF
LOOP
CLOSE #2
CLOSE #1
KILL "PLAYER.$$$"
f = 1
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 17, 15
Beeld 2, Bestand$
Venster 5, 10, 9, 70
COLOR 1
Beeld 5, " Bestand openen -" + STR$(t) + " bestanden gevonden "
COLOR 0
Muis 4, 0, y%, x%
DO
OPEN "PLAYER.!!!" FOR INPUT AS #1
FOR a = 1 TO f
LINE INPUT #1, a$
NEXT a
CLOSE #1
f$ = LEFT$(a$, 12)
t$ = RIGHT$(a$, LEN(a$) - 12)
IF LEN(t$) > 40 THEN t$ = LEFT$(t$, 40)
t$ = t$ + SPACE$(41 - LEN(t$))
COLOR 0, 7
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
LOCATE 6, 12: PRINT "Bestandsnaam: "; f$
LOCATE 8, 12: PRINT "Titel : "; t$
COLOR 7, 0: LOCATE 6, 68: PRINT CHR$(24)
COLOR 0, 7: LOCATE 7, 68: PRINT "░"
COLOR 7, 0: LOCATE 8, 68: PRINT CHR$(25)
Muis 4, 0, y%, x%
Loopje a$, k%, x%, y%, t%
IF k% = 1 THEN
IF x% = 6 AND y% = 68 THEN f = f - 1
IF x% = 8 AND y% = 68 THEN f = f + 1
END IF
SELECT CASE a$
CASE CHR$(27): KILL "PLAYER.!!!": EXIT SUB
CASE CHR$(0) + "P": f = f + 1
CASE CHR$(0) + "H": f = f - 1
END SELECT
IF f < 1 THEN f = t
IF f > t THEN f = 1
LOOP WHILE a$ <> CHR$(13)
Bestand$ = LTRIM$(f$)
KILL "PLAYER.!!!"
bk = -1
a$ = UCASE$(RIGHT$(Bestand$, 3))
IF a$ = "MUS" THEN BestandSoort = MusF
IF a$ = "KAR" THEN BestandSoort = KarF
IF a$ = "ASC" THEN BestandSoort = AscF
END SUB
SUB Speel
PLAY "O4"
o = 4
IF NOT bk THEN BEEP: EXIT SUB
IF BestandSoort = MusF OR BestandSoort = AscF THEN Versnel
HoofdScherm
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
COLOR 0, 3
LOCATE 25, 71: PRINT "-----:---";
Venster 10, 3, 15, 78
Spelen:
IF BestandSoort = KarF THEN OPEN Bestand$ FOR INPUT AS #1
IF BestandSoort = MusF OR BestandSoort = AscF THEN OPEN "PLAYER.TMP" FOR INPUT AS #1
COLOR 1, 15
IF BestandSoort <> AscF THEN
LINE INPUT #1, Titel$
IF LEN(Titel$) > 74 THEN Titel$ = LEFT$(Titel$, 58)
Beeld 10, Titel$
ELSE
Beeld 10, Bestand$
END IF
COLOR 0
Beeld 11, "Druk op een toets voor einde"
Beeld 13, "Bestand " + Bestand$
x = 0
Muis 4, 0, y%, x%
DO UNTIL EOF(1)
LINE INPUT #1, a$
IF BestandSoort = KarF THEN LINE INPUT #1, Tekst$
IF LEN(Tekst$) > 73 THEN Tekst$ = LEFT$(Tekst$, 73)
x = x + 1
Muis 3, 0, y%, x%
Muis 4, 0, 80 * 8 - 1, 25 * 8 - 1
Beeld 12, "Bezig met spelen regel" + STR$(x)
Beeld 14, SPACE$(73)
IF BestandSoort = KarF THEN Beeld 14, Tekst$
IF BestandSoort = MusF OR BestandSoort = AscF THEN
a = INSTR(a$, "A")
IF a = 0 THEN a = INSTR(a$, "B")
IF a = 0 THEN a = INSTR(a$, "C")
IF a = 0 THEN a = INSTR(a$, "D")
IF a = 0 THEN a = INSTR(a$, "E")
IF a = 0 THEN a = INSTR(a$, "F")
IF a = 0 THEN a = INSTR(a$, "G")
IF INSTR(a$, ">") > 0 THEN o = o + 1
IF INSTR(a$, "<") > 0 THEN o = o - 1
IF INSTR(a$, "O") > 0 THEN o = VAL(MID$(a$, INSTR(a$, "O") + 1, 1))
IF RIGHT$(a$, 1) = "+" THEN a = a + 1
IF RIGHT$(a$, 1) = "-" THEN a = a - 1
Lengte = a + (o * 7)
IF Lengte > 60 THEN Lengte = 60
IF Lengte < 1 THEN Lengte = 1
LOCATE 14, 5: PRINT STRING$(Lengte, 254); SPACE$(60 - Lengte)
END IF
Muis 4, 0, y%, x%
IF LEFT$(a$, 1) <> "'" THEN PLAY a$
IF INKEY$ <> "" GOTO Einde
LOOP
CLOSE #1
IF RepeatMus GOTO Spelen
Einde:
CLOSE #1
IF BestandSoort = MusF THEN KILL "PLAYER.TMP"
END SUB
FUNCTION Toets%
DEF SEG = 0
a% = PEEK(&H417)
'Lockstatus wordt weggehaald
'Daardoor blijft alleen de toetsstatus over
IF a% >= 128 THEN a% = a% - 128 'Insert
IF a% >= 64 THEN a% = a% - 64 'CapsLock
IF a% >= 32 THEN a% = a% - 32 'NumLock
IF a% >= 16 THEN a% = a% - 16 'ScrollLock
DEF SEG
Toets% = a%
END FUNCTION
SUB Venster (bx, by, ex, ey)
COLOR 0, 7
LOCATE bx, by: PRINT "┌"; STRING$(ey - by - 1, 196); "┐";
LOCATE ex, by: PRINT "└"; STRING$(ey - by - 1, 196); "┘";
FOR temp = bx + 1 TO ex - 1
LOCATE temp, by: PRINT "│"; SPACE$(ey - by - 1); "│";
NEXT temp
END SUB
SUB Versnel
HoofdScherm
OPEN Bestand$ FOR INPUT AS #1
OPEN "PLAYER.TMP" FOR OUTPUT AS #2
IF BestandSoort <> AscF THEN
LINE INPUT #1, a$
PRINT #2, a$
END IF
DO UNTIL EOF(1)
LINE INPUT #1, a$
a$ = LTRIM$(UCASE$(RTRIM$(a$)))
IF LEFT$(a$, 1) <> "'" THEN
c$ = ""
FOR a = 1 TO LEN(a$)
b$ = MID$(a$, a, 1)
c$ = c$ + b$
ok = 0
IF b$ = "A" THEN ok = -1
IF b$ = "B" THEN ok = -1
IF b$ = "C" THEN ok = -1
IF b$ = "D" THEN ok = -1
IF b$ = "E" THEN ok = -1
IF b$ = "F" THEN ok = -1
IF b$ = "G" THEN ok = -1
Controle:
IF a < LEN(a$) THEN d$ = MID$(a$, a + 1, 1) ELSE d$ = ""
IF d$ = "." OR d$ = "+" OR d$ = "-" THEN
c$ = c$ + d$
a = a + 1
GOTO Controle
END IF
IF ok = -1 THEN
d$ = c$
c$ = ""
FOR t = 1 TO LEN(d$)
e$ = MID$(d$, t, 1)
IF d$ <> " " THEN c$ = c$ + e$
NEXT t
PRINT #2, c$
c$ = ""
END IF
NEXT a
PRINT #2, c$
ELSE
PRINT #2, a$
END IF
LOOP
CLOSE #2
CLOSE #1
END SUB
FUNCTION ZoekMuis%
DEF SEG = 0
MSeg& = 256& * PEEK(51 * 4 + 3) + PEEK(51 * 4 + 2)
Mouse& = 256& * PEEK(51 * 4 + 1) + PEEK(51 * 4) + 2
MSeg$ = HEX$(MSeg&)
MouseSeg% = VAL("&H" + MSeg$)
Mouse$ = HEX$(Mouse&)
Mouse% = VAL("&H" + Mouse$)
IF MSeg& OR (Mouse% - 2) THEN
DEF SEG = MouseSeg%
IF PEEK(Mouse% - 2) = 207 THEN
DEF SEG
MenuMuis = 0
EXIT FUNCTION
END IF
END IF
DEF SEG = MouseSeg%
M1% = 0
CALL ABSOLUTE(M1%, M2%, M3%, M4%, Mouse%) 'Dit werkt foutloos in QBasic
ZoekMuis = -1 'In QB moet wel QB /L ingetypt
MButtons% = M2% 'worden
DEF SEG
END FUNCTION