SHARE.BAS

Go back

Below you'll find the source for the QBasic file SHARE.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 1996 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.

Download SHARE.BAS for QBasic

DEFINT A-Z
' Utils
DECLARE SUB Venster (BeginX, BeginY, EindeX, EindeY, Lijn)
DECLARE SUB Beeld (x, Tekst$)
DECLARE SUB Sterren ()
' Programma's
DECLARE SUB DatumViewerProgram ()
DECLARE SUB BingoAppaSpelletje ()
DECLARE SUB RekenenWerkprogram ()
DECLARE SUB Sterrenbeeldeninfo ()
DECLARE SUB KnightsAdSpelletje ()
DECLARE SUB DoolDwaalSpelletje ()
' Info
'
' Dit is een productie van de S.T.S.
' Staat voor Stefan Thoolen Software
'
'
Menu$ = " ShareWare Meer In Een 2.0 "
StartI:
SCREEN 0: COLOR 7, 8, 0: CLS : KEY OFF
COLOR 15, 0, 0
Venster 1, 1, 25, 80, 1
LOCATE 3, 1: PRINT "├"; STRING$(78, 196); "┤"
LOCATE 11, 1: PRINT "├"; STRING$(78, 196); "┤"
COLOR 0, 15, 0
Beeld 1, Menu$
Beeld 11, " Lees dit over ShareWare "
COLOR 7, 8, 0
LOCATE 2, 3: PRINT "F1 Naam wijzigen                                              Esc. Afsluiten"
LOCATE 4, 3: PRINT "A) Sterrenbeelden (Info)"
LOCATE 5, 3: PRINT "B) DoolDwaal (Spelletje)"
LOCATE 6, 3: PRINT "C) Knight's Adventure (Spelletje)"
LOCATE 7, 3: PRINT "D) Rekenprogramma (Werkprogramma)"
LOCATE 8, 3: PRINT "E) Bingo apparaat (Spelletje)"
LOCATE 9, 3: PRINT "F) BatchBas (Werkprogramma)"
LOCATE 10, 3: PRINT "G) DatumViewer (Util-Programma)"
LOCATE 12, 3: PRINT "Dit is een ShareWare versie van Meer In Een 2.0"
IF Verander$ = "*" THEN LOCATE 13, 3: PRINT "Naam kan niet worden gesaved."
LOCATE 14, 3: PRINT "Bij de echte versie van "; CHR$(34); "Meer In Een 2.1"; CHR$(34); " zijn 12 programma's."
IF Verander$ = "*" THEN LOCATE 15, 3: PRINT "Dan kan ook de naam gesaved worden."
LOCATE 16, 3: PRINT "Om de normale versie te krijgen stuur dan een brief naar het volgende adres"
LOCATE 17, 3: PRINT "-Address removed-"
LOCATE 18, 3: PRINT "48** ** Breda"
LOCATE 19, 3: PRINT "Nederland"
LOCATE 21, 3: PRINT "Stop er ƒ1,25 en je adres bij"
LOCATE 22, 3: PRINT "Ps. zet er bij dat het om "; CHR$(34); "Meer In Een 2.1"; CHR$(34); " gaat"
LOCATE 24, 3: PRINT "Dit programma mag vrij gekopieëerd worden.";
VraagI:
a$ = INKEY$: IF a$ = "" GOTO VraagI
b$ = UCASE$(a$): a$ = b$
IF a$ = CHR$(0) + ";" GOTO Naam
IF a$ = "A" THEN Sterrenbeeldeninfo
IF a$ = "B" THEN DoolDwaalSpelletje
IF a$ = "C" THEN KnightsAdSpelletje
IF a$ = "D" THEN RekenenWerkprogram
IF a$ = "E" THEN BingoAppaSpelletje
IF a$ = "F" THEN GOSUB BatchBas
IF a$ = "G" THEN DatumViewerProgram
IF a$ = CHR$(27) THEN CLS : GOTO EindeMeerProgramma
GOTO StartI
Naam:
CLS
COLOR 15, 0, 0
Venster 1, 1, 25, 80, 1
LOCATE 3, 1: PRINT "├"; STRING$(78, 196); "┤"
COLOR 0, 15, 0
Beeld 1, Menu$
COLOR 7, 8, 0
a$ = MID$(Menu$, 2, LEN(Menu$) - 2)
LOCATE 2, 3: PRINT CHR$(34); a$; CHR$(34);
INPUT " wijzigen in : ", a$
IF LEN(a$) > 70 THEN a$ = "ShareWare versie Meer In Een 2.0"
Menu$ = a$
a$ = " " + Menu$ + " "
Verander$ = "*"
Menu$ = a$
GOTO StartI
BatchBas:
CLS
INPUT "Batch-bestand : ", BATCH$
IF NOT UCASE$(RIGHT$(BATCH$, 4)) = ".BAT" THEN a$ = BATCH$ + ".BAT": BATCH$ = a$: a$ = ""
BASIC$ = BATCH$: a$ = LEFT$(BASIC$, LEN(BASIC$) - 4): b$ = a$ + ".BAS": BASIC$ = b$
LOCATE 1, 1: PRINT "Batch-bestand : "; UCASE$(BATCH$)
LOCATE 2, 1: PRINT "Basic-bestand : "; UCASE$(BASIC$)
ON ERROR GOTO EindeII
OPEN BATCH$ FOR INPUT AS #1
OPEN BASIC$ FOR OUTPUT AS #2
PRINT "Bestand "; UCASE$(BATCH$); " wordt ingelezen"
PRINT "Bestand "; UCASE$(BATCH$); " wordt omgezet naar "; UCASE$(BASIC$)
Start:
FOR a = 1 TO 100
ON ERROR GOTO EindeII
INPUT #1, a$
IF LEFT$(a$, 1) = "@" THEN GOSUB a
GOSUB b
NEXT a
GOTO Start
a:
b$ = UCASE$(MID$(a$, 2, LEN(a$)))
a$ = b$
RETURN
b:
IF a$ = "" THEN RETURN                          '═════════════════════════════
IF UCASE$(LEFT$(a$, 4)) = "CALL" GOTO Calling   'Commando [CALL]
IF UCASE$(LEFT$(a$, 2)) = "CD" GOTO Cd          'Commando [CD]
IF UCASE$(LEFT$(a$, 2)) = "MD" GOTO Md          'Commando [MD]
IF UCASE$(a$) = "CLS" GOTO ClsOk                'Commando [CLS]
IF UCASE$(LEFT$(a$, 4)) = "DATE" GOTO Datum     'Commando [DATE]
IF UCASE$(LEFT$(a$, 3)) = "DEL" GOTO Del        'Commando [DEL]
IF UCASE$(a$) = "DIR" GOTO Dir                  'Commando [DIR]
IF UCASE$(LEFT$(a$, 4)) = "ECHO" GOTO Echo      'Commando [ECHO]
IF UCASE$(LEFT$(a$, 4)) = "GOTO" GOTO GotoOk    'Commando [GOTO]
IF UCASE$(LEFT$(a$, 4)) = "MODE" GOTO Mode      'Commando [MODE]
IF UCASE$(a$) = "PAUSE" GOTO Pause              'Commando [PAUSE]
IF UCASE$(LEFT$(a$, 3)) = "REM" GOTO Remming    'Commando [REM]
IF UCASE$(LEFT$(a$, 4)) = "TIME" GOTO Tijd      'Commando [TIME]
IF LEFT$(a$, 1) = ":" GOTO Labels               '═════════════════════════════
GOTO Verwerk
Mode:
IF UCASE$(MID$(a$, 6, 10)) = "CO80" THEN PRINT #2, "screen 2:screen 0": RETURN
IF UCASE$(MID$(a$, 6, 10)) = "ZW80" THEN PRINT #2, "screen 2:screen 0": RETURN
IF UCASE$(MID$(a$, 6, 10)) = "CO40" THEN PRINT #2, "screen 1": RETURN
IF UCASE$(MID$(a$, 6, 10)) = "ZW40" THEN PRINT #2, "screen 1": RETURN
GOTO Verwerk
Datum:
PRINT #2, "?"; CHR$(34); "Datum is nu ingesteld op "; CHR$(34); "date$"
PRINT #2, "input "; CHR$(34); "Voer nieuwe datum in (mm-dd-jj): "; CHR$(34); ",a$"
PRINT #2, "DATE$=A$"
RETURN
Labels:
PRINT #2, RIGHT$(a$, LEN(a$) - 1); ":"
RETURN
GotoOk:
PRINT #2, a$
RETURN
Verwerk:
FOR a = 1 TO LEN(a$) - 4
IF UCASE$(MID$(a$, a, LEN(a$))) = ".BAS" GOTO Bas
NEXT a
PRINT #2, "SHELL "; CHR$(34); a$; CHR$(34): RETURN
Echo:
IF UCASE$(a$) = "ECHO OFF" THEN RETURN
PRINT #2, "PRINT "; CHR$(34); ""; MID$(a$, 6, LEN(a$)); ""; CHR$(34)
RETURN
Dir:
PRINT #2, "FILES "; CHR$(34); ""; MID$(a$, 5, LEN(a$)); ""; CHR$(34)
RETURN
Remming:
PRINT #2, "' "; MID$(a$, 5, LEN(a$))
RETURN
Cd:
IF MID$(a$, 3, 1) = " " THEN PRINT #2, "CHDIR "; CHR$(34); MID$(a$, 4, LEN(a$)); CHR$(34)
IF NOT MID$(a$, 3, 1) = " " THEN PRINT #2, "CHDIR "; CHR$(34); MID$(a$, 3, LEN(a$)); CHR$(34)
RETURN
Md:
IF MID$(a$, 3, 1) = " " THEN PRINT #2, "MKDIR "; CHR$(34); MID$(a$, 4, LEN(a$)); CHR$(34)
IF NOT MID$(a$, 3, 1) = " " THEN PRINT #2, "CHDIR "; CHR$(34); MID$(a$, 3, LEN(a$)); CHR$(34)
RETURN
Calling:
PRINT #2, "SHELL "; CHR$(34); ""; MID$(a$, 5, LEN(a$)); ""; CHR$(34)
RETURN
Del:
PRINT #2, "KILL "; CHR$(34); ""; MID$(a$, 5, LEN(a$)); ""; CHR$(34)
RETURN
ClsOk:
PRINT #2, "CLS"
RETURN
Pause:
PRINT #2, "PRINT "; CHR$(34); "Druk op een toets om verder te gaan . . . "; CHR$(34)
PRINT #2, "A$ = INPUT$(1)"
RETURN
Bas:
PRINT #2, "RUN "; CHR$(34); ""; a$
RETURN
Tijd:
PRINT #2, "PRINT "; CHR$(34); "Tijd is nu ingesteld op "; CHR$(34); "; TIME$"
PRINT #2, "INPUT "; CHR$(34); "Voer nieuwe tijd in: "; CHR$(34); ", A$"
PRINT #2, "TIME$ = A$"
RETURN
EindeII:
RESUME EindeIII
EindeIII:
ON ERROR GOTO EindeIIII
PRINT #2, "END"
EindeIIII:
GOTO StartI
RESUME NEXT
EindeMeerProgramma:
Kleur(1) = 4
Kleur(2) = 6
Kleur(3) = 12
CLS
COLOR Kleur(1), Kleur(2)
PRINT CHR$(218); STRING$(78, 196);
COLOR Kleur(3), Kleur(2)
PRINT CHR$(191);
FOR a = 2 TO 21
COLOR Kleur(1), Kleur(2)
LOCATE a, 1: PRINT CHR$(179); STRING$(78, 32);
COLOR Kleur(3), Kleur(2)
PRINT CHR$(179);
NEXT a
COLOR Kleur(1), Kleur(2)
LOCATE 22, 1: PRINT CHR$(192);
COLOR Kleur(3), Kleur(2)
PRINT STRING$(78, 196); CHR$(217);
'│=179
'┐=191
'└=192
'─=196
'┘=217
'┌=218
COLOR Kleur(1), Kleur(2)
LOCATE 2, 3: PRINT CHR$(218); STRING$(74, 196);
COLOR Kleur(3), Kleur(2)
PRINT CHR$(191)
FOR a = 1 TO 1
COLOR Kleur(1), Kleur(2)
PRINT CHR$(179); CHR$(32); CHR$(179); STRING$(74, 32);
COLOR Kleur(3), Kleur(2)
PRINT CHR$(179)
NEXT a
COLOR Kleur(1), Kleur(2)
LOCATE 4, 3: PRINT CHR$(192);
COLOR Kleur(3), Kleur(2)
PRINT STRING$(74, 196); CHR$(217)
COLOR 0, Kleur(2)
Beeld 3, "Stefan Thoolen Software Meer In Een 2.0"
COLOR Kleur(3), Kleur(2)
LOCATE 5, 3: PRINT CHR$(218); STRING$(74, 196);
COLOR Kleur(1), Kleur(2)
PRINT CHR$(191)
FOR a = 1 TO 12
COLOR Kleur(1), Kleur(2)
PRINT CHR$(179);
COLOR Kleur(3), Kleur(2)
PRINT CHR$(32); CHR$(179); STRING$(74, 32);
COLOR Kleur(1), Kleur(2)
PRINT CHR$(179)
NEXT a
COLOR Kleur(3), Kleur(2)
LOCATE 18, 3: PRINT CHR$(192);
COLOR Kleur(1), Kleur(2)
PRINT STRING$(74, 196); CHR$(217)
COLOR 0, Kleur(2)
Beeld 6, "Dit is de ShareWare versie van Meer In Een 2.1"
Beeld 7, "Om de normale versie te krijgen stuur dan een briefje naar het"
Beeld 8, "volgende adres:"
Beeld 10, "-Address removed-"
Beeld 11, "48** ** Breda"
Beeld 12, "Nederland"
Beeld 14, "Zet op de brief dat het om Meer In Een 2.1 gaat, en stop ƒ1,25 in"
Beeld 15, "de anvelop. Stop in de anvelop ook je naam en adres"
Beeld 16, "Als het buiten de Haagse Beemden in Breda is, stop dan ƒ2,00"
Beeld 17, "verzendkosten in de anvelop"
LOCATE 22, 1
COLOR 7, 0
SYSTEM

SUB Beeld (x, Tekst$)
y = 40 - (LEN(Tekst$) / 2)
LOCATE x, y: PRINT Tekst$
END SUB

SUB BingoAppaSpelletje
CLS
FoutjeInBingo:
INPUT "Het moet gaan tot "; Aantal
IF Aantal > 99 GOTO FoutjeInBingo
IF Aantal < 2 GOTO FoutjeInBingo
Regel.1:
CLS
Regel.2:
LOCATE 1, 1
PRINT "╔══════════════════╗"
PRINT "║12 34 65 75 54 52 ║"
PRINT "║5 31 43 67 13 4 45║"
PRINT "║65 56 54 74 34 23 ║"
PRINT "╚═══════════════╗──Î─"
PRINT "<SPATIE>        ║  ║"
Regel.3:
FOR a = 1 TO Aantal
a$ = INKEY$
LOCATE 1, 1
PRINT "╔══════════════════╗"
PRINT "║12 34 65 75 54 52 ║"
PRINT "║5 31 43 67 13 4 45║"
PRINT "║65 56 54 74 34 23 ║"
PRINT "╚═══════════════╗──Î─"
PRINT "<SPATIE>        ║  ║"
IF a$ <> "" THEN LOCATE 6, 1: PRINT "                "; a: Getal = a: GOTO Regel.4
LOCATE 1, 1
PRINT "╔══════════════════╗"
PRINT "║ 34 43 56 78 36 56║"
PRINT "║5 36 73 66 75 4 50║"
PRINT "║46 4 56 67 78 45 1║"
PRINT "╚═══════════════╗──Î─"
PRINT "<SPATIE>        ║  ║"
FOR b = 1 TO 100
NEXT b
NEXT a
GOTO Regel.3
Regel.4:
LOCATE 5, 1
PRINT "╚═══════════════╗ ─Î──"
FOR a = 1 TO 2000
NEXT a
LOCATE 5, 1
PRINT "╚═══════════════╗  Î───"
LOCATE 6, 1
PRINT "                ║"
LOCATE 6, 20: PRINT "║"
FOR a = 1 TO 2000
NEXT a
LOCATE 5, 1
PRINT "╚═══════════════╗ ─Î── "
FOR a = 1 TO 2000
NEXT a
LOCATE 5, 1
PRINT "╚═══════════════╗──Î─ "
LOCATE 10, 1
PRINT "A) Stoppen"
PRINT "B) Doorgaan"
Regel.6:
a$ = INKEY$
IF a$ = "A" GOTO Regel.7
IF a$ = "B" GOTO Regel.8
IF a$ = "a" GOTO Regel.7
IF a$ = "b" GOTO Regel.8
GOTO Regel.6
Regel.8:
CLS
GOTO Regel.1
Regel.7:
END SUB

SUB DatumViewerProgram
Regel1:
Maand$ = LEFT$(DATE$, 2)
Dag$ = MID$(DATE$, 4, 2)
Jaar$ = RIGHT$(DATE$, 4)
IF Maand$ = "01" THEN Maand$ = "Januari  "
IF Maand$ = "02" THEN Maand$ = "Februari "
IF Maand$ = "03" THEN Maand$ = "Maart    "
IF Maand$ = "04" THEN Maand$ = "April    "
IF Maand$ = "05" THEN Maand$ = "Mei      "
IF Maand$ = "06" THEN Maand$ = "Juni     "
IF Maand$ = "07" THEN Maand$ = "Juli     "
IF Maand$ = "08" THEN Maand$ = "Augustus "
IF Maand$ = "09" THEN Maand$ = "September"
IF Maand$ = "10" THEN Maand$ = "Oktober  "
IF Maand$ = "11" THEN Maand$ = "November "
IF Maand$ = "12" THEN Maand$ = "December "
a$ = INKEY$
IF a$ <> "" THEN COLOR 7, 8, 0: GOTO EindeLast
Uur$ = LEFT$(TIME$, 2)
e$ = MID$(TIME$, 4, 2)
d$ = RIGHT$(TIME$, 2)
IF Uur$ = "01" THEN b$ = "1": c$ = "snachts   "
IF Uur$ = "02" THEN b$ = "2": c$ = "snachts   "
IF Uur$ = "03" THEN b$ = "3": c$ = "snachts   "
IF Uur$ = "04" THEN b$ = "4": c$ = "snachts   "
IF Uur$ = "05" THEN b$ = "5": c$ = "snachts   "
IF Uur$ = "06" THEN b$ = "6": c$ = "sochtends "
IF Uur$ = "07" THEN b$ = "7": c$ = "sochtends "
IF Uur$ = "08" THEN b$ = "8": c$ = "sochtends "
IF Uur$ = "09" THEN b$ = "9": c$ = "sochtends "
IF Uur$ = "10" THEN b$ = "10": c$ = "sochtends"
IF Uur$ = "11" THEN b$ = "11": c$ = "sochtends"
IF Uur$ = "12" THEN b$ = "12": c$ = "smiddags "
IF Uur$ = "13" THEN b$ = "1": c$ = "smiddags  "
IF Uur$ = "14" THEN b$ = "2": c$ = "smiddags  "
IF Uur$ = "15" THEN b$ = "3": c$ = "smiddags  "
IF Uur$ = "16" THEN b$ = "4": c$ = "smiddags  "
IF Uur$ = "17" THEN b$ = "5": c$ = "smiddags  "
IF Uur$ = "18" THEN b$ = "6": c$ = "savonds   "
IF Uur$ = "19" THEN b$ = "7": c$ = "savonds   "
IF Uur$ = "20" THEN b$ = "8": c$ = "savonds   "
IF Uur$ = "21" THEN b$ = "9": c$ = "savonds   "
IF Uur$ = "22" THEN b$ = "10": c$ = "savonds  "
IF Uur$ = "23" THEN b$ = "11": c$ = "savonds  "
IF Uur$ = "24" THEN b$ = "12": c$ = "snachts  "
IF Uur$ = "00" THEN b$ = "12": c$ = "snachts  "
LOCATE 1, 1
PRINT "┌"; STRING$(20, 196); "┐"
PRINT "│ "; Dag$; " "; Maand$; " "; Jaar$; "  │"
PRINT "│ "; b$; ":"; e$; ":"; d$; " "; c$; " │"
PRINT "├"; STRING$(20, 196); "┤"
PRINT "│";
IF c$ = "savonds   " THEN PRINT "    Goede avond     ";
IF c$ = "snachts   " THEN PRINT "    Goede nacht     ";
IF c$ = "smiddags  " THEN PRINT "    Goede middag    ";
IF c$ = "sochtends " THEN PRINT "    Goede morgen    ";
IF c$ = "savonds    " THEN PRINT "    Goede avond     ";
IF c$ = "snachts    " THEN PRINT "    Goede nacht     ";
IF c$ = "smiddags   " THEN PRINT "    Goede middag    ";
IF c$ = "sochtends  " THEN PRINT "    Goede morgen    ";
IF c$ = "savonds  " THEN PRINT "    Goede avond     ";
IF c$ = "snachts  " THEN PRINT "    Goede nacht     ";
IF c$ = "smiddags " THEN PRINT "    Goede middag    ";
IF c$ = "sochtends" THEN PRINT "    Goede morgen    ";
PRINT "│"
PRINT "├"; STRING$(20, 196); "┤"
IF Dag$ = "31" THEN IF Maand$ = "December " THEN GOSUB Oudjaar
IF Dag$ = "01" THEN IF Maand$ = "Januari  " THEN GOSUB Nieuwjaar
PRINT "│ Druk op een toets. │"
PRINT "└"; STRING$(20, 196); "┘"
GOTO Regel1
DEF SEG = &H40
POKE (&H17), PEEK(&H17) AND &HDF
POKE (&H17), PEEK(&H17) OR &H40
DEF SEG
Nieuwjaar:
PRINT "│ Gelukkig nieuwjaar │"
PRINT "├"; STRING$(20, 196); "┤"
RETURN
Oudjaar:
PRINT "│  Gelukkig oudjaar  │"
PRINT "├"; STRING$(20, 196); "┤"
RETURN
EindeLast:
END SUB

SUB DoolDwaalSpelletje
CLS
SCREEN 1
x = 2
y = 2
Picture$ = CHR$(1)
StartII:
LOCATE 1, 1: PRINT "╔═══════════════════════════╗"
PLAY "T160O0L32EFGEFDC"
LOCATE x, y: PRINT Picture$
LOCATE 2, 1: PRINT "║ * *                       ║"
LOCATE x, y: PRINT Picture$
LOCATE 3, 1: PRINT "╠═════════════════════════╗ ║"
LOCATE x, y: PRINT Picture$
LOCATE 4, 1: PRINT "║      *    *             ║ ║"
LOCATE x, y: PRINT Picture$
LOCATE 5, 1: PRINT "║ ════════════════════════╝ ║"
LOCATE x, y: PRINT Picture$
LOCATE 6, 1: PRINT "║                           ║"
LOCATE x, y: PRINT Picture$
LOCATE 7, 1: PRINT "╠═══════════════════════*╔══╝"
LOCATE x, y: PRINT Picture$
LOCATE 8, 1: PRINT "║*                       ║"
LOCATE x, y: PRINT Picture$
LOCATE 9, 1: PRINT "╚════╗*══════════════════╩═══"
LOCATE x, y: PRINT Picture$
LOCATE 10, 6: PRINT "║"
LOCATE x, y: PRINT Picture$
LOCATE 11, 6: PRINT "╚═══════════════════════"
IF x = 2 THEN IF y = 3 THEN BEEP: LOCATE 10, 8: PRINT "G": g$ = "*"
IF x = 4 THEN IF y = 8 THEN BEEP: LOCATE 10, 9: PRINT "O": o$ = "*"
IF x = 2 THEN IF y = 5 THEN BEEP: LOCATE 10, 10: PRINT "E": e$ = "*"
IF x = 4 THEN IF y = 13 THEN BEEP: LOCATE 10, 11: PRINT "D": d$ = "*"
IF x = 8 THEN IF y = 2 THEN BEEP: LOCATE 10, 13: PRINT "Z": z$ = "*"
IF x = 9 THEN IF y = 7 THEN BEEP: LOCATE 10, 14: PRINT "O": o$ = "*"
IF x = 7 THEN IF y = 25 THEN BEEP: LOCATE 10, 15: PRINT "!": Uitroep$ = "*"
IF x = 1 GOTO Fout
IF y = 1 GOTO Fout
IF x = 3 THEN GOSUB Drie
IF x = 4 THEN GOSUB Vier
IF x = 5 THEN GOSUB Vijf
IF x > 6 THEN GOSUB Zes
IF x = 7 THEN GOSUB Zeven
IF x = 9 THEN GOSUB Negen
IF x = 10 GOTO Okee
IF y > 28 GOTO Fout
Vraag:
a$ = INKEY$
IF a$ = " " THEN z = y + 5: y = z
IF a$ = CHR$(0) + "H" THEN z = x - 1: x = z
IF a$ = CHR$(0) + "P" THEN z = x + 1: x = z
IF a$ = CHR$(0) + "K" THEN z = y - 1: y = z
IF a$ = CHR$(0) + "M" THEN z = y + 1: y = z
IF a$ = CHR$(0) + "R" THEN GOSUB Insert
IF a$ = CHR$(27) THEN SCREEN 2: SCREEN 0: GOTO Goed
IF a$ <> "" GOTO StartII
GOTO Vraag
Vier:
IF y = 27 GOTO Fout
RETURN
Drie:
IF y <> 28 GOTO Fout
RETURN
Vijf:
IF y <> 2 THEN IF y <> 28 GOTO Fout
RETURN
Insert:
IF Picture$ = CHR$(1) THEN Picture$ = CHR$(2): RETURN
Picture$ = CHR$(1)
RETURN
Negen:
IF y <> 7 GOTO Fout
RETURN
Zes:
IF y > 25 GOTO Fout
RETURN
Zeven:
IF y <> 25 GOTO Fout
RETURN
Okee:
SCREEN 2
SCREEN 0
IF g$ = "" GOTO Fout
IF o$ = "" GOTO Fout
IF e$ = "" GOTO Fout
IF d$ = "" GOTO Fout
IF z$ = "" GOTO Fout
IF o$ = "" GOTO Fout
IF Uitroep$ = "" GOTO Fout
Beeld 2, "Goed zo !"
Beeld 23, "Druk op een toets"
Sterren
GOTO Goed
Fout:
SCREEN 2
SCREEN 0
Beeld 2, "U bent G A M E   O V E R"
Beeld 23, "Druk op een toets"
Sterren
Goed:
END SUB

SUB KnightsAdSpelletje
1 CLS
PRINT "Je begint bij een ╦ splitsing en je kan : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtsaf"
Vraag.1:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "A" THEN 2
IF a$ = "a" THEN 2
IF a$ = "B" THEN 3
IF a$ = "b" THEN 3
IF a$ = "" GOTO Vraag.1
BEEP: GOTO Vraag.1
2 CLS
PRINT "Je komt bij een ╠ splitsing aan en kan : ": PRINT
PRINT "A) Rechtsaf"
PRINT "B) Rechtdoor"
PRINT "C) Terug"
Vraag.2:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "A" THEN 7
IF a$ = "a" THEN 7
IF a$ = "B" THEN 8
IF a$ = "b" THEN 8
IF a$ = "C" THEN 3
IF a$ = "c" THEN 3
IF a$ = "" GOTO Vraag.2
BEEP: GOTO Vraag.2
3 CLS
PRINT "Je komt bij een mooie ╣ splitsing aan en kan het volgende : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtdoor"
PRINT "C) Terug"
Vraag.3:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "A" THEN 6
IF a$ = "a" THEN 6
IF a$ = "B" THEN 4
IF a$ = "b" THEN 4
IF a$ = "C" THEN 2
IF a$ = "c" THEN 2
IF a$ = "" GOTO Vraag.3
BEEP: GOTO Vraag.3
4 CLS
PRINT "Je komt weer bij een splitsing ╠ en kan : ": PRINT
PRINT "A) Rechtdoor"
PRINT "B) Rechtsaf"
PRINT "C) Terug"
Vraag.4:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "A" THEN 10
IF a$ = "a" THEN 10
IF a$ = "B" THEN 12
IF a$ = "b" THEN 12
IF a$ = "C" THEN 11
IF a$ = "c" THEN 11
IF a$ = "" GOTO Vraag.4
BEEP: GOTO Vraag.4
6 CLS
PRINT "Je komt alweer bij een splitsing ╦ en kan het volgende : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtsaf"
PRINT "C) terug"
Vraag.6:
IF a$ = CHR$(27) GOTO EindeZ
a$ = INKEY$
IF a$ = "a" THEN 3
IF a$ = "A" THEN 3
IF a$ = "b" THEN 8
IF a$ = "B" THEN 8
IF a$ = "c" THEN 7
IF a$ = "C" THEN 7
IF a$ = "" GOTO Vraag.6
BEEP: GOTO Vraag.6
7 CLS
PRINT "Je komt bij een ╦ splitsing en kan het volgende : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtsaf"
PRINT "C) terug"
Vraag.7:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "a" THEN 4
IF a$ = "A" THEN 4
IF a$ = "b" THEN 2
IF a$ = "B" THEN 2
IF a$ = "c" THEN 6
IF a$ = "C" THEN 6
IF a$ = "" GOTO Vraag.7
BEEP: GOTO Vraag.7
8 CLS
PRINT "Je komt bij een ruige ╣ splitsing en hebt de mogelijkheden : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtdoor"
PRINT "C) Terug"
Vraag.8:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "a" THEN 12
IF a$ = "A" THEN 12
IF a$ = "b" THEN 11
IF a$ = "B" THEN 11
IF a$ = "c" THEN 10
IF a$ = "C" THEN 10
IF a$ = "" GOTO Vraag.8
BEEP: GOTO Vraag.8
10 CLS
PRINT "Je komt bij een superdeluxe ╣ splitsing aan en kan : ": PRINT
PRINT "A) Linksaf"
PRINT "B) Rechtdoor"
PRINT "C) terug"
Vraag.10:
a$ = INKEY$
IF a$ = "a" THEN 7
IF a$ = "A" THEN 7
IF a$ = "b" THEN 3
IF a$ = "B" THEN 3
IF a$ = "c" THEN 8
IF a$ = "C" THEN 8
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "" GOTO Vraag.10
BEEP: GOTO Vraag.10
11 CLS
PRINT "Je komt al weer bij een splitsing ╠ en je kan deze dingen : ": PRINT
PRINT "A) Rechtsaf"
PRINT "B) Rechtdoor"
PRINT "C) Terug"
Vraag.11:
a$ = INKEY$
IF a$ = CHR$(27) GOTO EindeZ
IF a$ = "a" THEN 6
IF a$ = "A" THEN 6
IF a$ = "b" THEN 2
IF a$ = "B" THEN 2
IF a$ = "c" THEN 4
IF a$ = "C" THEN 4
IF a$ = "" GOTO Vraag.11
BEEP: GOTO Vraag.11
12 CLS
PRINT "Het is je gelukt ! druk op een toets"
Vraag.12:
a$ = INKEY$
IF a$ = "" GOTO Vraag.12
EindeZ:
END SUB

SUB RekenenWerkprogram
CLS
Aa:
PRINT
INPUT "Getal 1 "; a
INPUT "Getal 2 "; b
CLS
PRINT a; "+"; b; "="; a + b
PRINT a; "-"; b; "="; a - b
PRINT a; "x"; b; "="; a * b
IF a = 0 THEN IF b = 0 GOTO Ab
PRINT a; ":"; b; "="; a / b
Ab:
PRINT
PRINT "Druk op V om verder te gaan en op S om te stoppen"
Vraag.a:
a$ = INKEY$
IF a$ = "V" GOTO Aa
IF a$ = "v" GOTO Aa
IF a$ = "S" GOTO Einde.1
IF a$ = "s" GOTO Einde.1
IF a$ = "" GOTO Vraag.a
BEEP
GOTO Vraag.a
Einde.1:
END SUB

SUB Sterren
COLOR 14, 8, 0
a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = ""
FOR a = 1 TO 5
LOCATE 1, 1
PRINT MID$(a$, a, 80);
LOCATE 22, 1
PRINT MID$(a$, 6 - a, 80);
FOR b = 2 TO 21
c = (a + b) MOD 5
IF c = 1 THEN
LOCATE b, 80
PRINT "*";
LOCATE 23 - b, 1
PRINT "*";
 ELSE
LOCATE b, 80
PRINT " ";
LOCATE 23 - b, 1
PRINT " ";
END IF
NEXT b
NEXT a
WEND
COLOR 7, 8, 0
END SUB

SUB Sterrenbeeldeninfo
CLS
PRINT "╔══════════════╦══════════════╦══════════════╗"
PRINT "║ Sterrenbeeld:║ Van:         ║ Tot:         ║"
PRINT "╠══════════════╬══════════════╬══════════════╣"
PRINT "║ Steenbok     ║ 1  Januari   ║ 20 Januari   ║"
PRINT "║ Waterman     ║ 21 Januari   ║ 19 Februari  ║"
PRINT "║ Vissen       ║ 20 Februari  ║ 20 Maart     ║"
PRINT "║ Ram          ║ 21 Maart     ║ 20 April     ║"
PRINT "║ Stier        ║ 21 April     ║ 21 Mei       ║"
PRINT "║ Tweelingen   ║ 22 Mei       ║ 21 Juni      ║"
PRINT "║ Kreeft       ║ 22 Juni      ║ 22 Juli      ║"
PRINT "║ Leeuw        ║ 22 Juli      ║ 22 Augustus  ║"
PRINT "║ Maagd        ║ 23 Augustus  ║ 22 September ║"
PRINT "║ Weegschaal   ║ 23 September ║ 23 Oktober   ║"
PRINT "║ Schorpioen   ║ 24 Oktober   ║ 22 November  ║"
PRINT "║ Boogschutter ║ 23 November  ║ 21 December  ║"
PRINT "║ Steenbok     ║ 22 December  ║ 31 December  ║"
PRINT "╚══════════════╩══════════════╩══════════════╝"
Beeld 23, "Druk op een toets om verder te gaan"
a$ = INPUT$(1)
CLS
END SUB

SUB Venster (BeginX, BeginY, EindeX, EindeY, Lijn)
IF Lijn = 1 GOTO SoortI
IF Lijn = 2 GOTO SoortII
SoortI:
LOCATE BeginX, BeginY: PRINT "┌";
LOCATE EindeX, BeginY: PRINT "└";
LOCATE BeginX, EindeY: PRINT "┐";
LOCATE EindeX, EindeY: PRINT "┘";
FOR a = BeginY + 1 TO EindeY - 1
LOCATE BeginX, a: PRINT "─";
LOCATE EindeX, a: PRINT "─";
NEXT a
FOR b = BeginX + 1 TO EindeX - 1
LOCATE b, BeginY: PRINT "│";
LOCATE b, EindeY: PRINT "│";
NEXT b
GOTO EindeI
SoortII:
LOCATE BeginX, BeginY: PRINT "╔";
LOCATE EindeX, BeginY: PRINT "╚";
LOCATE BeginX, EindeY: PRINT "╗";
LOCATE EindeX, EindeY: PRINT "╝";
FOR a = BeginY + 1 TO EindeY - 1
LOCATE BeginX, a: PRINT "═";
LOCATE EindeX, a: PRINT "═";
NEXT a
FOR b = BeginX + 1 TO EindeX - 1
LOCATE b, BeginY: PRINT "║";
LOCATE b, EindeY: PRINT "║";
NEXT b
GOTO EindeI
EindeI:
END SUB