home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcresour / 1988_07 / makemenu.bas < prev    next >
BASIC Source File  |  1987-12-23  |  13KB  |  381 lines
  1. 'MM003.BAS - LR 10/10/87 11:00pm  (final)
  2. '----------------------------------------------------------------------------
  3. '    Menu Maker, by Jim Woodruff - Sept. 7, 1987
  4. '    written in QUICK BASIC 2.01 (c)1985,1986 Microsoft Corporation
  5. '
  6. '    A utility for making menu's and help screens.
  7. '    The files created by MENU MAKER can be Bloaded into screen memory by
  8. '    any basic program...
  9. '----------------------------------------------------------------------------
  10. '
  11. DEFINT A-Z
  12. KEY 1, CHR$(255) + CHR$(13)
  13. foreC = 7: row = 1: col = 1
  14. VIEW PRINT 1 TO 25
  15.  
  16. hello:
  17.     LOCATE 7, 6: FOR i = 0 TO 7: COLOR 7, 0: PRINT USING "   #_-"; i;
  18.     COLOR i, 0: PRINT STRING$(2, 219); : NEXT
  19.     LOCATE 10, 27, 1, 0, 7: PRINT "Choose main screen color ";
  20.     main$ = INPUT$(1): main = VAL(main$): PRINT main$
  21.     IF main < 0 OR main > 7 THEN SOUND 550, .5: GOTO hello
  22.     backC = main: COLOR 7, main: CLS
  23.     GOTO Getcommand
  24.  
  25. Status:
  26.     COLOR 7, 0
  27.     LOCATE 25, 65, 0: PRINT USING "Y=## X=## C="; row; col;
  28.     COLOR foreC, backC: PRINT USING "##/#"; foreC; backC;
  29.     COLOR 7, 0
  30.     RETURN
  31.  
  32. GetPos:
  33.     Updated = -1
  34.     LOCATE row, col, 1
  35.     k$ = "": WHILE k$ = "": k$ = INKEY$: WEND
  36.     k = ASC(RIGHT$(k$, 1))
  37.       IF k = 72 THEN row = row - 1: GOTO MoveCursor
  38.       IF k = 80 THEN row = row + 1: GOTO MoveCursor
  39.       IF k = 75 THEN col = col - 1: GOTO MoveCursor
  40.       IF k = 77 THEN col = col + 1: GOTO MoveCursor
  41.       IF k = 71 THEN col = 1: row = 1: GOTO MoveCursor
  42.       IF k = 116 THEN col = col + 8: GOTO MoveCursor
  43.       IF k = 115 THEN col = col - 8: GOTO MoveCursor
  44.       IF k = 117 THEN col = col2: GOTO MoveCursor
  45.       IF k = 27 OR k = 13 THEN RETURN
  46.     GOTO GetPos:
  47.  
  48. MoveCursor:
  49.     IF row < 1 THEN row = 24 ELSE IF row > 24 THEN row = 1
  50.     IF col < 1 THEN col = 80 ELSE IF col > 80 THEN col = 1
  51.     GOSUB Status
  52.     GOTO GetPos
  53.  
  54. Getcommand:
  55.     COLOR 7, 0: LOCATE 25, 1, 0
  56.     PRINT "(B)ox (L)ine (T)ext D(R)aw (C)olor (D)isk (F)ill (O)ops (Q)uit";
  57.     GOSUB Status
  58.     k$ = "": WHILE k$ = "": k$ = INKEY$: WEND
  59.     IF k$ = "B" OR k$ = "b" THEN PCOPY 0, 1: GOTO Box
  60.     IF k$ = "L" OR k$ = "l" THEN PCOPY 0, 1: GOTO Lin
  61.     IF k$ = "C" OR k$ = "c" THEN GOTO colr
  62.     IF k$ = "T" OR k$ = "t" THEN PCOPY 0, 1: GOTO text
  63.     IF k$ = "R" OR k$ = "r" THEN PCOPY 0, 1: PCOPY 0, 3: GOTO Drawing
  64.     IF k$ = "D" OR k$ = "d" THEN GOTO FileWork
  65.     IF k$ = "F" OR k$ = "f" THEN PCOPY 0, 1: GOTO FillArea
  66.     IF k$ = "O" OR k$ = "o" THEN PCOPY 1, 0: GOTO Getcommand
  67.     IF k$ = "Q" OR k$ = "q" THEN GOTO ProgramEnd
  68.     SOUND 550, .5
  69.     GOTO Getcommand
  70.  
  71. Box:
  72.     PCOPY 0, 3
  73.     GOSUB Blankline
  74.     PRINT "Move cursor to upper left corner of box then press enter.";
  75.     GOSUB GetPos
  76.       IF k = 27 THEN GOTO cancel
  77.     LOCATE row, col: PRINT CHR$(218)
  78.     row1 = row: col1 = col
  79.     GOSUB Blankline
  80.     PRINT "Move cursor to lower right corner of box then press enter.";
  81.     GOSUB GetPos
  82.       IF k = 27 THEN GOTO cancel
  83.       IF row - 1 < row1 OR col - 1 <= col1 THEN SOUND 550, .5: GOSUB CursErr: GOTO Box
  84.     LOCATE row, col: PRINT CHR$(217)
  85.     row2 = row: col2 = col
  86.     GOSUB Blankline
  87.     PRINT "(*D)ouble or (S)ingle line ";
  88.     style$ = INPUT$(1)
  89.       IF style$ = CHR$(27) THEN GOTO cancel
  90.       IF style$ = "D" OR style$ = "d" THEN style$ = "D":  ELSE IF style$ = "S" OR style$ = "s" THEN style$ = "S":  ELSE style$ = "D"
  91.     GOSUB Blankline
  92.     PRINT "(F)illed or (*N)ot filled ";
  93.     fill$ = INPUT$(1)
  94.       IF fill$ = CHR$(27) THEN GOTO cancel
  95.       IF fill$ = "F" OR fill$ = "f" THEN fill$ = "F":  ELSE IF fill$ = "N" OR fill$ = "n" THEN fill$ = "N":  ELSE fill$ = "N"
  96.     PCOPY 3, 0
  97.       IF style$ = "S" THEN c1 = 218: c2 = 191: c3 = 192: c4 = 217: horzchr = 196: vertchr = 179
  98.       IF style$ = "D" THEN c1 = 201: c2 = 187: c3 = 200: c4 = 188: horzchr = 205: vertchr = 186
  99.       horzlen = (col2 - col1) - 1
  100.     COLOR foreC, backC
  101.     LOCATE row1, col1, 0: PRINT CHR$(c1); STRING$(horzlen, horzchr); CHR$(c2)
  102.     FOR i = row1 + 1 TO row2 - 1
  103.         LOCATE i, col1: PRINT CHR$(vertchr);
  104.           IF fill$ = "F" THEN PRINT STRING$(horzlen, 32);
  105.         LOCATE i, col2: PRINT CHR$(vertchr)
  106.     NEXT i
  107.     LOCATE row2, col1: PRINT CHR$(c3); STRING$(horzlen, horzchr); CHR$(c4);
  108.     GOTO Getcommand
  109.  
  110. Lin:
  111.     PCOPY 0, 3
  112.     GOSUB Blankline
  113.     PRINT "(D)ouble or (*S)ingle line ";
  114.     style$ = INPUT$(1)
  115.        IF style$ = CHR$(27) THEN GOTO cancel
  116.        IF style$ = "D" OR style$ = "d" THEN style$ = "D": horzchr = 205:   ELSE horzchr = 196: style$ = "S"
  117.     GOSUB Blankline
  118.     PRINT "Position cursor at begining of line...";
  119.     GOSUB GetPos
  120.     col1 = col: row1 = row
  121.        IF k = 27 THEN GOTO cancel
  122.        chr = SCREEN(row, col)
  123.        IF chr = 179 AND style$ = "S" THEN c1 = 195:  ELSE IF chr = 179 AND style$ = "D" THEN c1 = 198:  ELSE IF chr = 186 AND style$ = "S" THEN c1 = 199:  ELSE IF chr = 186 AND style$ = "D" THEN c1 = 204:  ELSE c1 = horzchr
  124.        COLOR foreC, backC: PRINT CHR$(c1);
  125.     GOSUB Blankline
  126.     PRINT "Position cursor at end of line...";
  127.     GOSUB GetPos
  128.        IF k = 27 THEN GOTO cancel
  129.        IF row <> row1 OR col - 1 <= col1 THEN SOUND 550, .5: GOSUB CursErr: GOTO Lin
  130.        chr = SCREEN(row, col)
  131.        IF chr = 179 AND style$ = "S" THEN c2 = 180:  ELSE IF chr = 179 AND style$ = "D" THEN c2 = 181:  ELSE IF chr = 186 AND style$ = "S" THEN c2 = 182:  ELSE IF chr = 186 AND style$ = "D" THEN c2 = 185:  ELSE c2 = horzchr
  132.        COLOR foreC, backC
  133.        LOCATE row, col1, 0
  134.        PRINT CHR$(c1); STRING$((col - col1) - 1, horzchr); CHR$(c2)
  135.        GOTO Getcommand
  136.  
  137. CursErr:
  138.     GOSUB Blankline
  139.     PRINT "Cursor position error.  Press <ANY KEY> to continue";
  140.     k$ = INPUT$(1): PCOPY 3, 0
  141.     RETURN
  142.  
  143. text:
  144.     PCOPY 0, 3
  145.     GOSUB Blankline
  146.     PRINT "Position cursor and press <ENTER>...";
  147.     GOSUB GetPos
  148.     IF k = 27 THEN GOTO cancel
  149.     GOSUB Blankline
  150.     PRINT "Enter text at cursor.";
  151.     COLOR foreC, backC
  152.     LOCATE row, col, 1: LINE INPUT ; ""; text$
  153.  
  154. Text2:
  155.     GOSUB Blankline
  156.     PRINT "Reposition (*Y/N) ";
  157.     r$ = INPUT$(1)
  158.        IF r$ = CHR$(27) THEN GOTO cancel
  159.        IF r$ = "N" OR r$ = "n" THEN GOTO Getcommand
  160.     GOSUB Blankline
  161.     PRINT "(*C)enter or (R)eposition cursor ";
  162.     k$ = INPUT$(1)
  163.        IF k$ = CHR$(27) THEN GOTO cancel
  164.        IF k$ = "R" OR k$ = "r" THEN GOTO Movetext
  165.     PCOPY 3, 0: COLOR foreC, backC
  166.     col = 40 - LEN(text$) / 2: LOCATE row, col: PRINT text$;
  167.     GOTO Text2
  168.  
  169. Movetext:
  170.     GOSUB Blankline
  171.     PRINT "Move cursor to new position, press <ENTER> when ready.";
  172.     row2 = row: col2 = col
  173.     GOSUB GetPos
  174.       IF k = 27 THEN GOTO cancel
  175.       IF POS(0) + LEN(text$) - 1 > 80 THEN
  176.         SOUND 550, .5: GOSUB Blankline
  177.         PRINT "Not enough room, press <ANY KEY> to continue.";
  178.         r$ = INPUT$(1): GOTO Movetext
  179.       END IF
  180.     PCOPY 3, 0
  181.     LOCATE row2, col2
  182.     COLOR foreC, backC
  183.     LOCATE row, col: PRINT text$
  184.     GOTO Text2
  185.  
  186. colr:
  187.     GOSUB Blankline
  188.     FOR i = 0 TO 15: COLOR i, 0: PRINT USING "## "; i; : NEXT: COLOR 7, 0
  189.     LINE INPUT ; " foreground: "; foreC$
  190.       IF foreC$ <> "" THEN foreC = VAL(foreC$)
  191.       IF foreC > 31 THEN SOUND 550, .5: GOTO colr
  192.     GOSUB Blankline
  193.     FOR i = 0 TO 7: COLOR 15, i: PRINT USING "## "; i; : NEXT: COLOR 7, 0
  194.     LINE INPUT ; " background: "; backC$
  195.       IF backC$ <> "" THEN backC = VAL(backC$)
  196.       IF backC > 7 THEN SOUND 550, .5: GOTO colr
  197.     GOTO Getcommand
  198.  
  199. Drawing:
  200.     GOSUB Blankline
  201.     LINE INPUT ; "Enter character or code to draw with. (F1 for list) "; g$
  202.       IF g$ = "" THEN GOTO Getcommand
  203.       IF g$ = CHR$(255) THEN PCOPY 0, 3: GOTO GraphicList
  204.       IF LEN(g$) = 1 AND ASC(g$) < 127 THEN GOTO Drawing2
  205.     g = VAL(g$): IF g < 1 OR g > 254 THEN SOUND 550, .5: GOTO Drawing
  206.     g$ = CHR$(g)
  207.  
  208. Drawing2:
  209.     GOSUB Blankline
  210.     LOCATE 25, 1: COLOR foreC, backC: PRINT g$;
  211.     COLOR 7, 0: PRINT "  Press <ENTER> to place character, <Esc> to Stop. ";
  212.  
  213. Drawing3:
  214.     GOSUB GetPos
  215.       IF k = 27 THEN GOTO Drawing
  216.       IF k = 13 THEN COLOR foreC, backC
  217.     LOCATE row, col: PRINT g$
  218.     GOTO Drawing3
  219.  
  220. GraphicList:
  221.     PCOPY 0, 3
  222.     IF Gexist THEN PCOPY 2, 0: GOTO Gexist
  223.     colr = 15: CLS
  224.     FOR i = 1 TO 22
  225.         COLOR colr, 0
  226.         LOCATE i, 3
  227.         PRINT i + 122; "- "; CHR$(i + 122); "     ";
  228.         PRINT i + 144; "- "; CHR$(i + 144); "     ";
  229.         PRINT i + 166; "- "; CHR$(i + 166); "     ";
  230.         PRINT i + 188; "- "; CHR$(i + 188); "     ";
  231.         PRINT i + 210; "- "; CHR$(i + 210); "     ";
  232.         PRINT i + 232; "- "; CHR$(i + 232); "     ";
  233.         IF colr = 15 THEN colr = 7 ELSE colr = 15
  234.     NEXT i
  235.     PCOPY 0, 2: Gexist = -1
  236.  
  237. Gexist:
  238.     GOSUB Blankline
  239.     LINE INPUT ; "Enter character or code to draw with: "; g$
  240.       IF g$ = "" THEN GOTO cancel
  241.       IF LEN(g$) = 1 AND ASC(g$) < 127 THEN PCOPY 3, 0: GOTO Drawing2
  242.     g = VAL(g$): IF g < 1 OR g > 254 THEN SOUND 550, .5: GOTO Gexist
  243.     g$ = CHR$(g): PCOPY 3, 0
  244.     GOTO Drawing2
  245.  
  246. FillArea:
  247.     PCOPY 0, 3: GOSUB Blankline
  248.     PRINT "Move cursor to upper left corner of area then press enter.";
  249.     GOSUB GetPos
  250.       IF k = 27 THEN GOTO cancel
  251.     LOCATE row, col: PRINT CHR$(218)
  252.     row1 = row: col1 = col
  253.     GOSUB Blankline
  254.     PRINT "Move cursor to lower right corner of area then press enter.";
  255.     GOSUB GetPos
  256.       IF k = 27 THEN GOTO cancel
  257.     LOCATE row, col: PRINT CHR$(217)
  258.       IF row - 1 < row1 OR col - 1 <= col1 THEN SOUND 550, .5: GOSUB CursErr: GOTO FillArea
  259.     row2 = row: col2 = col
  260.  
  261. FillColr:
  262.     GOSUB Blankline
  263.     FOR i = 0 TO 7: COLOR 15, i: PRINT USING "## "; i; : NEXT: COLOR 7, 0
  264.     LINE INPUT ; " Fill color: "; EraseC$
  265.       IF EraseC$ = "" THEN EraseC = main:  ELSE EraseC = VAL(EraseC$)
  266.       IF EraseC > 7 THEN SOUND 550, .5: GOTO FillColr
  267.     COLOR 7, EraseC
  268.     FOR i = row1 TO row2: LOCATE i, col1: PRINT STRING$(col2 - col1 + 1, 32); : NEXT i
  269.     GOTO Getcommand
  270.  
  271. cancel:
  272.     PCOPY 3, 0: GOTO Getcommand
  273.  
  274. FileWork:
  275.     PCOPY 0, 3
  276.     GOSUB Blankline
  277.     PRINT "(S)ave or (L)oad  ";
  278.     k$ = INPUT$(1)
  279.       IF k$ = CHR$(27) THEN GOTO cancel
  280.       IF k$ = "S" OR k$ = "s" THEN GOTO SaveScreen
  281.       IF k$ = "L" OR k$ = "l" THEN GOTO LoadScreen
  282.     SOUND 550, .5: GOTO FileWork
  283.  
  284. SaveScreen:
  285.     FileCanceled = 0
  286.     GOSUB Blankline
  287.       IF LEN(Tfile$) > 0 THEN PRINT "Use "; Tfile$; " for save ? "; :      i$ = INPUT$(1):        IF i$ = "Y" OR i$ = "y" THEN File$ = Tfile$: GOTO SaveScreen3
  288.  
  289. SaveScreen2:
  290.     GOSUB Blankline
  291.     LINE INPUT ; "Save filename: "; File$
  292.       IF File$ = "" THEN GOTO cancel
  293.       IF File$ = "?" THEN GOTO Directory
  294.     Tfile$ = File$
  295.     GOSUB CheckFile: ON ERROR GOTO 0
  296.       IF FileCanceled THEN GOTO cancel
  297.  
  298. SaveScreen3:
  299.     PCOPY 3, 0: COLOR 7, 0
  300.     LOCATE 25, 1: PRINT STRING$(80, 32);
  301.     DEF SEG = &HB800
  302.     ON ERROR GOTO DirError
  303.     BSAVE File$, 0, &H1000
  304.     ON ERROR GOTO 0
  305.     Updated = 0
  306.     GOTO Getcommand
  307.  
  308. LoadScreen:
  309.     GOSUB Blankline
  310.       IF Updated THEN SOUND 550, .5:               PRINT "Screen has been edited.  Continue with load? (Y/*N) "; :               i$ = INPUT$(1): IF i$ = "N" OR i$ = "n" OR i$ = CHR$(13) THEN GOTO cancel
  311.  
  312. LoadScreen2:
  313.     GOSUB Blankline
  314.     LINE INPUT ; "Load filename: "; File$
  315.       IF File$ = "?" THEN GOTO Directory
  316.       IF File$ = "" THEN GOTO cancel
  317.     GOSUB Blankline
  318.     PRINT "Loading "; File$;
  319.     DEF SEG = &HB800
  320.     ON ERROR GOTO DirError
  321.     OPEN "i", #1, File$: CLOSE                      'catch disk i/o errors
  322.     BLOAD File$, 0: Tfile$ = File$: Updated = 0
  323.     ON ERROR GOTO 0
  324.     GOTO Getcommand
  325.  
  326. CheckFile:
  327.     ON ERROR GOTO FileNameOK
  328.     OPEN "i", #1, File$: CLOSE : SOUND 550, .5
  329.     GOSUB Blankline
  330.     PRINT File$; " exists, overwrite it? ";
  331.     i$ = INPUT$(1)
  332.       IF i$ = "Y" OR i$ = "y" THEN RETURN
  333.     FileCanceled = -1
  334.     RETURN
  335.  
  336. FileNameOK:
  337.     RESUME FileNameOK2
  338. FileNameOK2:
  339.     CLOSE : RETURN
  340.  
  341. Directory:
  342.     ON ERROR GOTO DirError
  343.     GOSUB Blankline
  344.     LINE INPUT ; "Dir Mask: "; File$
  345.     CLS : FILES File$
  346.     ON ERROR GOTO 0
  347.       IF k$ = "S" OR k$ = "s" THEN GOTO SaveScreen2
  348.       IF k$ = "L" OR k$ = "l" THEN GOTO LoadScreen2
  349.     GOTO cancel
  350.  
  351. DirError:
  352.     IF ERR = 53 THEN er$ = File$ + " not found. ": RESUME ErrPrint
  353.     IF ERR = 61 THEN er$ = "Disk is full. ": RESUME ErrPrint
  354.     IF ERR = 62 OR ERR = 54 THEN er$ = File$ + " was not BSAVE'ed. ":                                                                                                  RESUME ErrPrint
  355.     IF ERR = 64 OR ERR = 52 THEN er$ = File$ + " <- Invalid filespec. ":                                                                                                  RESUME ErrPrint
  356.     IF ERR = 70 THEN er$ = "Disk is write protected. ": RESUME ErrPrint
  357.     IF ERR = 71 THEN er$ = "Disk drive not responding. ": RESUME ErrPrint
  358.     IF ERR = 76 THEN er$ = File$ + " <- Invalid path. ": RESUME ErrPrint
  359.     er$ = "Error #" + STR$(ERR) + " has occured. ": RESUME ErrPrint
  360.  
  361. ErrPrint:
  362.     ON ERROR GOTO 0
  363.     CLOSE
  364.     GOSUB Blankline: SOUND 550, .5
  365.     PRINT er$; "Press any key to continue.";
  366.     i$ = INPUT$(1)
  367.       IF k$ = "S" OR k$ = "s" THEN GOTO SaveScreen
  368.       IF k$ = "L" OR k$ = "l" THEN GOTO LoadScreen2
  369.  
  370. Blankline:
  371.     COLOR 7, 0: LOCATE 25, 1, 0: PRINT STRING$(64, 32); : LOCATE 25, 1
  372.     RETURN
  373.  
  374. ProgramEnd:
  375.     GOSUB Blankline
  376.     PRINT "Are sure you want to quit ? (Y/*N) ";
  377.        k$ = INPUT$(1)
  378.        IF k$ = "Y" OR k$ = "y" THEN COLOR 7, 0, 0: CLS : END
  379.        GOTO Getcommand
  380.  
  381.