PAINT.BAS

Go back

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 2023.
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 PAINT.BAS for QBasic

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