'===========================================================================
' Subject: GRAPHICS DRAWING PROGRAM          Date: 04-12-96 (23:28)       
' Author:  Einar Tveit                       Code: QB, QBasic, PDS        
' Origin:  comp.lang.basic.misc            Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB Refresh (file$, colors%)
REM The intro was made with this program!!!
REM Hi, this program was made by Espen Tveit (me) to make it easy
REM programming graphic in qbasic, when you have printed your filename
REM push enter and start drawing. If you have any comments send them to me:
REM
REM eintveit@telepost.no
REM 
REM I`m on the newsgroups:
REM comp.os.ms-dos.programmer
REM comp.lang.basic.misc
REM
REM Notice: This program automatic sets .bas behind the filname
REM (This program will make an .qtf file, if you wants to open the file later
REM just print the filename and this program will open the .qtf file)
REM ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
REM I`m just programming
REM ßßßßßßßßßßßßßßßßßßßß
DEFINT A-Z
Screenmode = 8
VIEW PRINT 1 TO 25
Startcolor = 10
SCREEN Screenmode
ON KEY(1) GOSUB help
KEY(1) ON
SCREEN Screenmode
LINE (2, 2)-(2, 630), 7
LINE (3, 2)-(3, 630), 8
LINE (1, 1)-(638, 198), 7, B
LINE (1, 99)-(637, 99)
LINE (0, 0)-(639, 199), 7, B
LINE (2, 197)-(636, 197)
LINE (636, 2)-(636, 2)
LINE (1, 102)-(638, 102), 8
LINE (1, 100)-(638, 101), 7, B
LINE (252, 3)-(252, 21), 8
LINE (352, 2)-(352, 21), 8
LINE (249, 22)-(352, 22), 8
LINE (249, 3)-(249, 21)
LINE (250, 1)-(251, 20), 7, BF
LINE (250, 20)-(350, 21), 7, BF
LINE (350, 1)-(351, 21), 7, BF
LINE (2, 2)-(638, 2), 8
LINE (252, 19)-(348, 19), 15
LINE (349, 3)-(349, 19), 15
COLOR 7
LOCATE 2, 34: PRINT "Qdraw 5.0"
LOCATE 5, 31: PRINT "Espen Tveit 1996"
LOCATE 15, 10: PRINT "Do not print somthing behind the filname such as .bas"
LOCATE 17, 10: INPUT "File: ", fi$
file$ = fi$ + ".qtf"
fil$ = fi$ + ".bas"
OPEN fil$ FOR APPEND AS #1
OPEN file$ FOR APPEND AS #2
CLS
colors% = Startcolor
A = 5
B = 5
PRINT #1, "SCREEN "; Screenmode
beveg:
FOR o% = 1 TO 15 STEP 1
P = P + 1
COLOR o%
LOCATE 23, P: PRINT "Û"
COLOR 15
LOCATE 23, 17: PRINT "Using color:                                         "
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
NEXT o%
COLOR 15
LOCATE 22, colors%: PRINT ""
DO
IF wh = 1 THEN
GOSUB fil
END IF
PSET (A, B), colors%
SELECT CASE INKEY$
CASE "*"
CLOSE #1
CLOSE #2
CLOSE #3
Refresh file$, colors%
CLOSE #1
CLOSE #2
CLOSE #3
OPEN fil$ FOR APPEND AS #1
OPEN file$ FOR APPEND AS #2
CASE "1"
GOSUB sirkel
CASE CHR$(0) + CHR$(83)
N = 1
K = 1
wh = 1
PRINT #2, "P"
PRINT #2, A
PRINT #2, B
PRINT #2, "0"
PRINT #2,
PRINT #2,
PRINT #1, "PSET ("; A; ","; B; "), 0"

CASE "+"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% + 1
IF colors% = 16 THEN colors% = 15
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE "-"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% - 1
IF colors% = 0 THEN colors% = 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE CHR$(32)
N = 1
K = 1
wh = 1

PRINT #2, "P"
PRINT #2, A
PRINT #2, B
PRINT #2, colors%
PRINT #2,
PRINT #2,
PRINT #1, "PSET ("; A; ","; B; "), "; colors%
CASE "3"
BEG = 0
BEG1 = 0
BEG = BEG + A
BEG1 = BEG1 + B
GOSUB firkant1
CASE "4"
BEG = 0
BEG1 = 0
BEG = BEG + A
BEG1 = BEG1 + B
GOSUB strek
CASE "2"
BEG = 0
BEG1 = 0
BEG = BEG + A
BEG1 = BEG1 + B
GOSUB firkant
CASE CHR$(0) + "P"
IF K = 0 THEN
PSET (A, B), 0
END IF
B = B + 1
PSET (A, B), colors%
IF ET = 1 THEN
GOSUB lagre
ELSE
K = 0
END IF
CASE "5"
COLOR colors%
OL = A / 8
OL1 = B / 8
IF OL = 0 THEN OL = 1
IF OL1 = 0 THEN OL1 = 1
LOCATE OL1, OL: INPUT "", f$
IF PEN$ = "I" OR PEN$ = "i" THEN
N = 1
K = 1
wh = 1
PRINT #2, "Tekst"
PRINT #2, OL1
PRINT #2, OL
PRINT #2, f$
PRINT #2, colors%
PRINT #2,
ELSE
PRINT #1, "COLOR "; colors%
PRINT #1, "LOCATE"; OL1; ","; OL; ":"; "PRINT "; CHR$(34); f$; CHR$(34)
PRINT #1, "COLOR 15"
N = 1
K = 1
wh = 1
PRINT #2, "Tekst"
PRINT #2, OL1
PRINT #2, OL
PRINT #2, f$
PRINT #2, colors%
PRINT #2,
END IF

CASE CHR$(0) + "K"
IF K = 0 THEN
PSET (A, B), 0
END IF
A = A - 1
PSET (A, B), colors%
IF ET = 1 THEN
GOSUB lagre
ELSE
K = 0
END IF
CASE CHR$(27)
PRINT #1, "DO"
PRINT #1, "LOOP"
CLS
END
CASE CHR$(0) + "M"
IF K = 0 THEN
PSET (A, B), 0
END IF
A = A + 1
PSET (A, B), colors%
IF ET = 1 THEN
GOSUB lagre
ELSE
K = 0
END IF
END SELECT
LOOP

help:
CLS
COLOR 15
VIEW PRINT 1 TO 25
LINE (131, 28)-(131, 28), 7
LINE (131, 28)-(506, 97), 7, B
LINE (506, 98)-(131, 98), 8
LINE (130, 98)-(130, 27), 15
LINE (130, 27)-(506, 27), 15
LINE (507, 27)-(507, 98), 8
LINE (505, 96)-(132, 96), 15
LINE (132, 96)-(132, 29), 8
LINE (505, 29)-(505, 96), 15
LOCATE 1, 23: PRINT "Ï  Help for Qdraw 4.0  Ï"
LOCATE 5, 18: PRINT "Push <F1> to get help"
LOCATE 6, 18: PRINT "Push <*> to refresh"
LOCATE 7, 18: PRINT "Push <SPACE> to draw a point on the screen"
LOCATE 8, 18: PRINT "Push <1> to draw an circle"
LOCATE 9, 18: PRINT "Push <2> to draw an square"
LOCATE 10, 18: PRINT "Push <3> to make an filled square"
LOCATE 11, 18: PRINT "Push <4> to make a line"
LOCATE 12, 18: PRINT "Push <5> to set in text"
LOCATE 17, 20: PRINT "Espen Tveit 1996"
LOCATE 23, 18: PRINT "Press a key to continue..."
DO
LOOP WHILE INKEY$ = ""
CLS
P = 0
PSET (A, B), colors%
FOR o% = 1 TO 15 STEP 1
P = P + 1
COLOR o%
LOCATE 23, P: PRINT "Û"
COLOR 15
LOCATE 23, 17: PRINT "Bruker farge:                                         "
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
NEXT o%
COLOR 15
LOCATE 22, colors%: PRINT ""
IF wh = 0 THEN RETURN
IF OK1 = 0 THEN
OK1 = 1
CLOSE #1
CLOSE #2
OPEN file$ FOR INPUT AS #3
END IF
DO UNTIL EOF(3)
LINE INPUT #3, valg$
IF valg$ = "T" THEN
LINE INPUT #3, rec$
OL1 = VAL(rec$)
LINE INPUT #3, rec$
OL = VAL(rec$)
LINE INPUT #3, rec$
LINE INPUT #3, farge$
KL = VAL(farge$)
COLOR KL
LOCATE OL1, OL: PRINT rec$
COLOR 15
END IF
IF valg$ = "P" THEN
 LINE INPUT #3, rec$
 G = VAL(rec$)

 LINE INPUT #3, rec$
 H = VAL(rec$)

 LINE INPUT #3, rec$
 LINE INPUT #3, o$
 Q = VAL(rec$)
 PSET (G, H), Q
END IF
IF valg$ = "BF" THEN
LINE INPUT #3, rec$
G = VAL(rec$)
LINE INPUT #3, rec$
H = VAL(rec$)
LINE INPUT #3, rec$
I = VAL(rec$)
LINE INPUT #3, rec$
J = VAL(rec$)
LINE INPUT #3, rec$
CF = VAL(rec$)
LINE (G, H)-(I, J), CF, BF
END IF
IF valg$ = "B" THEN
LINE INPUT #3, rec$
G = VAL(rec$)
LINE INPUT #3, rec$
H = VAL(rec$)
LINE INPUT #3, rec$
I = VAL(rec$)
LINE INPUT #3, rec$
J = VAL(rec$)
LINE INPUT #3, rec$
CF = VAL(rec$)
LINE (G, H)-(I, J), CF, B
END IF

IF valg$ = "Strek" THEN
LINE INPUT #3, rec$
G = VAL(rec$)
LINE INPUT #3, rec$
H = VAL(rec$)
LINE INPUT #3, rec$
I = VAL(rec$)
LINE INPUT #3, rec$
J = VAL(rec$)
LINE INPUT #3, rec$
CF = VAL(rec$)
LINE (G, H)-(I, J), CF
END IF
IF valg$ = "S" THEN
LINE INPUT #3, rec$
G = VAL(rec$)
LINE INPUT #3, rec$
H = VAL(rec$)
LINE INPUT #3, rec$
RADIUS = VAL(rec$)
LINE INPUT #3, rec$
CF = VAL(rec$)
CIRCLE (G, H), RADIUS, CF
END IF
LOOP
CLOSE #1
CLOSE #2
OPEN fil$ FOR APPEND AS #1
CLOSE #2
OPEN file$ FOR APPEND AS #2
RETURN


lagre:
N = 1
K = 1
wh = 1

PRINT #2, "P"
PRINT #2, A
PRINT #2, B
PRINT #2, colors%
PRINT #2,
PRINT #2,
PRINT #1, "PSET ("; A; ","; B; "), "; colors%
RETURN

firkant:
LINE (BEG, BEG1)-(A, B), colors%, B
DO
SELECT CASE INKEY$
CASE CHR$(0) + "H"
LINE (BEG, BEG1)-(A, B), 0, B
B = B - 1
LINE (BEG, BEG1)-(A, B), colors%, B
CASE CHR$(0) + "P"
LINE (BEG, BEG1)-(A, B), 0, B
B = B + 1
LINE (BEG, BEG1)-(A, B), colors%, B
CASE "+"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% + 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE "-"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% - 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE CHR$(0) + "K"
LINE (BEG, BEG1)-(A, B), 0, B
A = A - 1
LINE (BEG, BEG1)-(A, B), colors%, B
CASE CHR$(0) + "M"
LINE (BEG, BEG1)-(A, B), 0, B
A = A + 1
LINE (BEG, BEG1)-(A, B), colors%, B
CASE CHR$(13)
N = 1
K = 1
wh = 1
PRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%; ", B"
PRINT #2, "B"
PRINT #2, BEG
PRINT #2, BEG1
PRINT #2, A
PRINT #2, B
PRINT #2, colors%
N = 1
K = 1
wh = 1
RETURN
END SELECT
LOOP

firkant1:
LINE (BEG, BEG1)-(A, B), colors%, BF
DO
SELECT CASE INKEY$
CASE CHR$(0) + "H"
LINE (BEG, BEG1)-(A, B), 0, BF
B = B - 1
LINE (BEG, BEG1)-(A, B), colors%, BF
CASE CHR$(0) + "P"
LINE (BEG, BEG1)-(A, B), 0, BF
B = B + 1
LINE (BEG, BEG1)-(A, B), colors%, BF
CASE "+"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% + 1
IF farge = 16 THEN farge = 15
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE "-"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% - 1
IF farge = 0 THEN farge = 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE CHR$(0) + "K"
LINE (BEG, BEG1)-(A, B), 0, BF
A = A - 1
LINE (BEG, BEG1)-(A, B), colors%, BF
CASE CHR$(0) + "M"
LINE (BEG, BEG1)-(A, B), 0, BF
A = A + 1
LINE (BEG, BEG1)-(A, B), colors%, BF
CASE CHR$(13)
N = 1
K = 1
wh = 1
PRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%; ", BF"
PRINT #2, "BF"
PRINT #2, BEG
PRINT #2, BEG1
PRINT #2, A
PRINT #2, B
PRINT #2, colors%
N = 1
K = 1
wh = 1
RETURN
END SELECT
LOOP

strek:
LINE (BEG, BEG1)-(A, B), colors%
DO
SELECT CASE INKEY$
CASE CHR$(0) + "H"
LINE (BEG, BEG1)-(A, B), 0
B = B - 1
LINE (BEG, BEG1)-(A, B), colors%
CASE CHR$(0) + "P"
LINE (BEG, BEG1)-(A, B), 0
B = B + 1
LINE (BEG, BEG1)-(A, B), colors%
CASE "+"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% + 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE "-"
COLOR 0
LOCATE 22, colors%: PRINT ""
colors% = colors% - 1
COLOR colors%
COLOR 15
LOCATE 22, colors%: PRINT ""
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
CASE CHR$(0) + "K"
LINE (BEG, BEG1)-(A, B), 0
A = A - 1
LINE (BEG, BEG1)-(A, B), colors%
CASE CHR$(0) + "M"
LINE (BEG, BEG1)-(A, B), 0
A = A + 1
LINE (BEG, BEG1)-(A, B), colors%
CASE CHR$(13)
N = 1
K = 1
wh = 1
PRINT #1, "LINE ("; BEG; ","; BEG1; ")-("; A; ","; B; ") ,"; colors%
PRINT #2, "Strek"
PRINT #2, BEG
PRINT #2, BEG1
PRINT #2, A
PRINT #2, B
PRINT #2, colors%
N = 1
K = 1
wh = 1
RETURN
END SELECT
LOOP


sirkel:
DO
SELECT CASE INKEY$
CASE "+"
COLOR 0
LOCATE 22, plass%: PRINT ""
colors% = colors% + 1
COLOR colors%
COLOR 15
plass% = colors% + 1
LOCATE 22, plass%: PRINT ""
COLOR colors%
LOCATE 23, 18 + 20: PRINT "Û"
CASE "-"
COLOR 0
LOCATE 22, plass%: PRINT ""
colors% = colors% - 1
COLOR colors%
COLOR 15
plass% = colors% - 1
IF colors% = 0 THEN
plass% = 2
colors% = 1
END IF
LOCATE 22, plass%: PRINT ""
COLOR colors%
LOCATE 23, 18 + 20: PRINT "Û"
CASE CHR$(0) + "H"
CIRCLE (A, B), RADIUS, 0
RADIUS = RADIUS + 1
CIRCLE (A, B), RADIUS, colors%

CASE CHR$(0) + "P"
CIRCLE (A, B), RADIUS, 0
RADIUS = RADIUS - 1
IF RADIUS = 0 THEN RADIUS = 1
CIRCLE (A, B), RADIUS, colors%
CASE CHR$(13)
PRINT #1, "CIRCLE ("; A; ","; B; "),"; RADIUS; ","; colors%
wh = 1
PRINT #2, "S"
PRINT #2, A
PRINT #2, B
PRINT #2, RADIUS
PRINT #2, colors%
RETURN
END SELECT
LOOP

fil:
RETURN

SUB Refresh (file$, colors%)
OPEN file$ FOR INPUT AS #1
P = 0
FOR o% = 1 TO 15 STEP 1
P = P + 1
COLOR o%
LOCATE 23, P: PRINT "Û"
COLOR 15
LOCATE 23, 17: PRINT "Bruker farge:                                         "
COLOR colors%
LOCATE 23, 17 + 15: PRINT "Û"
NEXT o%
COLOR 15
LOCATE 22, colors%: PRINT ""

  DO
  IF EOF(1) THEN
  GOTO slutt
END IF
  LINE INPUT #1, valg$
  IF valg$ = "T" THEN
  LINE INPUT #1, rec$
  OL1 = VAL(rec$)
  LINE INPUT #1, rec$
  OL = VAL(rec$)
  LINE INPUT #1, rec$
  LINE INPUT #1, farge$
  KL = VAL(farge$)
  COLOR KL
  LOCATE OL1, OL: PRINT rec$
  COLOR 15
  END IF
  IF valg$ = "P" THEN
  LINE INPUT #1, rec$
  G = VAL(rec$)
  LINE INPUT #1, rec$
  H = VAL(rec$)
  LINE INPUT #1, rec$
  LINE INPUT #1, o$
  Q = VAL(rec$)
  PSET (G, H), Q
  END IF

  IF valg$ = "BF" THEN
  LINE INPUT #1, rec$
  G = VAL(rec$)
  LINE INPUT #1, rec$
  H = VAL(rec$)
  LINE INPUT #1, rec$
  I = VAL(rec$)
  LINE INPUT #1, rec$
  J = VAL(rec$)
  LINE INPUT #1, rec$
  CF = VAL(rec$)
  LINE (G, H)-(I, J), CF, BF
  END IF
  IF valg$ = "B" THEN
  LINE INPUT #1, rec$
  G = VAL(rec$)
  LINE INPUT #1, rec$
  H = VAL(rec$)
  LINE INPUT #1, rec$
  I = VAL(rec$)
  LINE INPUT #1, rec$
  J = VAL(rec$)
  LINE INPUT #1, rec$
  CF = VAL(rec$)
  LINE (G, H)-(I, J), CF, B
  END IF

  IF valg$ = "Strek" THEN
  LINE INPUT #1, rec$
  G = VAL(rec$)
  LINE INPUT #1, rec$
  H = VAL(rec$)
  LINE INPUT #1, rec$
  I = VAL(rec$)
  LINE INPUT #1, rec$
  J = VAL(rec$)
  LINE INPUT #1, rec$
  CF = VAL(rec$)
  LINE (G, H)-(I, J), CF
  END IF
  IF valg$ = "S" THEN
  LINE INPUT #1, rec$
  G = VAL(rec$)
  LINE INPUT #1, rec$
  H = VAL(rec$)
  LINE INPUT #1, rec$
  RADIUS = VAL(rec$)
  LINE INPUT #1, rec$
  CF = VAL(rec$)
  CIRCLE (G, H), RADIUS, CF
  END IF
 LOOP
 RETURN

slutt:
END SUB