Below you'll find the source for the QBasic file PAINT.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 2025.
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.
DECLARE SUB PALLET (a!, b!, g!, r!)
DECLARE SUB LOOPJE (to$, mx%, my%, kn%, co%)
DIM Punt%(18, 32)
Klr = 63
SCREEN 13
FOR a = 0 TO 279
b = a
IF b > 255 THEN b = b - 255
COLOR b
PRINT CHR$(219);
NEXT a
Klr$ = LTRIM$(STR$(Klr))
Klr$ = STRING$(3 - LEN(Klr$), "0") + Klr$
COLOR 63: LOCATE 25, 37: PRINT Klr$;
COLOR Klr: PRINT CHR$(219);
'Zie routine PALLET(a, r, g, b)
FOR a = 0 TO 63: PALLET a, a, a, a: NEXT a
FOR a = 64 TO 127: PALLET a, a - 64, 0, 0: NEXT a
FOR a = 128 TO 191: PALLET a, 0, a - 128, a - 128: NEXT a
FOR a = 192 TO 255: PALLET a, 0, 0, a - 192: NEXT a
Bouw:
'Punten
FOR a = 1 TO 18: FOR b = 1 TO 32: COLOR Punt%(a, b): LOCATE a + 7, b: PRINT CHR$(219); : NEXT b: NEXT a
LINE (256, 64)-(256, 200), 63
Toets:
Klr$ = LTRIM$(STR$(Klr))
Klr$ = STRING$(3 - LEN(Klr$), "0") + Klr$
COLOR 63: LOCATE 25, 37: PRINT Klr$;
COLOR Klr: PRINT CHR$(219);
'Zie routine LOOPJE(to$, mx%, my%, kn%, co%)
LOOPJE to$, mx%, my%, kn%, co%
IF to$ = CHR$(27) THEN
SCREEN 0
WIDTH 80, 25
CLS
SYSTEM
END IF
IF to$ = CHR$(13) THEN
SCREEN 0
WIDTH 80, 25
CLS
LINE INPUT ".PIC-bestand: "; SGF$
SGF$ = LTRIM$(UCASE$(RTRIM$(SGF$)))
a = INSTR(SGF$, ".")
IF a = 0 THEN
PRINT "Geen extentie aangegeven"
PRINT SGF$; ".PIC van maken [J/N]?";
x = CSRLIN: y = POS(1)
a$ = ""
DO
LOCATE x, y, 1: PRINT a$;
IF a$ <> "" THEN BEEP
a$ = UCASE$(INPUT$(1))
LOOP WHILE a$ <> "J" AND a$ <> "N"
LOCATE x, y, 0: PRINT a$;
IF a$ = "J" THEN SGF$ = SGF$ + ".PIC"
END IF
PRINT
p1# = .0015625: x = CSRLIN
c# = 0
OPEN SGF$ FOR OUTPUT AS #1
FOR a = 0 TO 320
FOR b = 0 TO 200
c# = c# + 1
'Aantal tellen─┐
'1%──────┐ │
Proc# = p1# * c#
IF Proc# > 100 THEN Proc# = 100 'Loopt tot 100.81 vreemd genoeg
'Voor extra duidelijkheid─────────────────────────────┐
'Procent-getal─────────────────────────────────────┐ │
LOCATE x, 1: PRINT USING "Bezig met figuur opslaan###.## procent"; Proc#;
IF b < 19 AND a < 33 THEN c = Punt%(b, a) ELSE c = 0
PRINT #1, c;
IF b < 200 THEN PRINT #1, ","; ELSE PRINT #1, ""
NEXT b
NEXT a
PRINT
PRINT "Bezig met pallet opslaan"
FOR a = 0 TO 63: PRINT #1, a; ","; a; ","; a: NEXT a
FOR a = 64 TO 127: PRINT #1, 0; ","; 0; ","; a - 64: NEXT a
FOR a = 128 TO 191: PRINT #1, a - 128; ","; a - 128; ","; 0: NEXT a
FOR a = 192 TO 255: PRINT #1, a - 192; ","; 0; ","; 0: NEXT a
CLOSE #1
SYSTEM
END IF
IF kn% = 1 THEN
IF mx% < 8 THEN
'Totale X-as──────┬─+1─┐
'Op X-as─────┐ │ │ ┌─────Op de Y-as
Klr = mx% * 40 - 41 + my%
IF Klr > 255 THEN Klr = Klr - 255
END IF
IF mx% > 7 AND my% < 33 THEN
x = mx% - 7
Punt%(x, my%) = Klr
GOTO Bouw
END IF
END IF
GOTO Toets
SUB LOOPJE (to$, mx%, my%, kn%, co%)
'ASCII────┘ │ │ │ └─────Toetsenbordcode
'Muis X-as─────┘ │ └─────Muisknop
' Muis Y-as
COLOR 63
DEF SEG = &H40
tx& = PEEK(&H84) + 1
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%
ma% = 1: mb% = 0: mc% = 0: md% = 0
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * │
' In QBasic werkt dit foutloos, in QuickBasic moet je QB /L typen * │
CALL ABSOLUTE(ma%, mb%, mc%, md%, MouseCode%)' *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ■
ma% = 3
CALL ABSOLUTE(ma%, mb%, my%, mx%, MouseCode%)
DEF SEG
DO
DEF SEG = MouseSeg%
ma% = 3
CALL ABSOLUTE(ma%, kn%, my%, mx%, MouseCode%)
DEF SEG
DEF SEG = 0
co% = PEEK(&H417)
IF co% >= 128 THEN co% = co% - 128
IF co% >= 64 THEN co% = co% - 64
IF co% >= 32 THEN co% = co% - 32
IF co% >= 16 THEN co% = co% - 16
DEF SEG
to$ = INKEY$
my% = my% / 16 + .5
mx% = mx% / 8 + .5
IF my% = 0 THEN my% = 1
IF mx% = 0 THEN mx% = 1
mx$ = LTRIM$(STR$(mx%))
my$ = LTRIM$(STR$(my%))
mx$ = STRING$(2 - LEN(mx$), "0") + mx$
my$ = STRING$(2 - LEN(my$), "0") + my$
LOCATE 24, 36: PRINT mx$; ","; my$;
LOOP WHILE kn% = 0 AND co% = 0 AND to$ = ""
DO
DEF SEG = MouseSeg%
ma% = 3
CALL ABSOLUTE(ma%, te%, my%, mx%, MouseCode%)
DEF SEG
my% = my% / 16 + .5
mx% = mx% / 8 + .5
IF my% = 0 THEN my% = 1
IF mx% = 0 THEN mx% = 1
mx$ = LTRIM$(STR$(mx%))
my$ = LTRIM$(STR$(my%))
mx$ = STRING$(2 - LEN(mx$), "0") + mx$
my$ = STRING$(2 - LEN(my$), "0") + my$
LOCATE 24, 36: PRINT mx$; ","; my$;
LOOP WHILE te% <> 0
DEF SEG = MouseSeg%
ma% = 2: mb% = 0: mc% = 0: md% = 0
CALL ABSOLUTE(ma%, mb%, mc%, md%, MouseCode%)
DEF SEG
END SUB
SUB PALLET (a, b, g, r)
'Tinten blauw─────────┐ ┌────────Tinten groen
'Attribuut─┐ │ │ ┌──────Tinten rood
PALETTE a, 65536 * b + 256 * g + r
END SUB