PC Consument 1997 #6/pc-consument-1997-6.iso/thoolen/00000001.exe/rar/PAINT.BAS

BASIC Source File | 1997-04-22 | 5KB | 173 lines

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