home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / c / cutl.zip / COLORSET.BAS < prev    next >
BASIC Source File  |  1993-03-01  |  2KB  |  58 lines
  1. 100 ' PCCOLOR.BAS -- by PS -- FOR COLOR SYSTEMS ONLY!
  2. 110 ' (c) 1988 Ziff Communications Co.
  3. 120 ' Creates PCCOLOR.COM program with or without CLS feature
  4. 130 '
  5. 140 ' --- Setup ---
  6. 150 '
  7. 160 SCREEN 0:KEY OFF:COLOR 3,0,0:LOCATE ,,0:CLS:DIM C1$(31),C2$(36)
  8. 170 FOR A=1 TO 31:READ A$:C1$(A)=A$:NEXT
  9. 180 FOR A=1 TO 36:READ A$:C2$(A)=A$:NEXT
  10. 190 '
  11. 200 ' --- Ask which version to create and get screen size ---
  12. 210 '
  13. 220 PRINT TAB(18);"Do you want this to clear the screen (Y/N)? ";
  14. 230 W$=INPUT$(1):IF INSTR("YyNn",W$)=0 THEN 230 ELSE PRINT W$:PRINT
  15. 240 PRINT TAB(18);"Are you using a normal 25-line screen (Y/N)? ";
  16. 250 Y$=INPUT$(1):Y=INSTR("YyNn",Y$):IF Y=0 THEN 250 ELSE PRINT Y$:PRINT
  17. 260 IF Y<3 THEN 360
  18. 270 LOCATE 3,18:PRINT "Enter the number of lines on your screen (26-50): "
  19. 280 LOCATE 3,68:INPUT;"",N$:IF VAL(N$)>25 AND VAL(N$)<51 THEN 300
  20. 290 LOCATE 3,68:PRINT SPC(13):GOTO 280
  21. 300 N=VAL(N$):IF INSTR("Nn",W$) THEN 320
  22. 310 C1$(17)=HEX$(N-1):GOTO 360
  23. 320 C2$(19)=HEX$(80*N\256):C2$(18)=HEX$((80*N)-256*VAL("&H"+C2$(19)))
  24. 330 '
  25. 340 ' --- Get Inputs ---
  26. 350 '
  27. 360 PRINT:PRINT:COLOR 3:PRINT "FOR BORDER ------ ";:GOSUB 610:BORD$=I$
  28. 370 COLOR 3:PRINT "(Anything higher than 7 will blink:)"
  29. 380 PRINT "FOR BACKGROUND -- ";:GOSUB 610:BACK$=I$
  30. 390 COLOR 3:PRINT "FOR FOREGROUND -- ";:GOSUB 610
  31. 400 IF I$=BACK$ THEN BEEP:GOTO 390 ELSE FORE$=I$
  32. 410 '
  33. 420 ' --- Create File ---
  34. 430 '
  35. 440 OPEN "PCCOLOR.COM" AS 1 LEN=1:FIELD 1,1 AS B$
  36. 450 IF INSTR("Nn",W$) THEN 480
  37. 460 C1$(5)=BORD$:C1$(19)=BACK$+FORE$
  38. 470 FOR A=1 TO 31:LSET B$=CHR$(VAL("&H"+C1$(A))):PUT 1:NEXT:GOTO 500
  39. 480 C2$(6)=BORD$:C2$(23)=BACK$+FORE$
  40. 490 FOR A=1 TO 36:LSET B$=CHR$(VAL("&H"+C2$(A))):PUT 1:NEXT
  41. 500 PRINT "PCCOLOR.COM created...":CLOSE:END
  42. 510 '
  43. 520 ' --- DATA ---
  44. 530 '
  45. 540 DATA B8,00,0B,BB,00,00,CD,10,B8,00,06,B9,00,00,BA,4F
  46. 550 DATA 18,B7,00,CD,10,B4,02,BA,00,00,B7,00,CD,10,C3
  47. 560 DATA B4,0B,B7,00,B3,00,CD,10,B8,00,B8,8E,D8,BE,00,00,B9,D0
  48. 570 DATA 07,C6,44,01,00,83,C6,02,49,85,C9,75,F4,B8,00,4C,CD,21
  49. 580 '
  50. 590 ' --- Input Subroutine ---
  51. 600 '
  52. 610 COLOR 3,0:PRINT "Pick a color:  ";
  53. 620 COLOR 0,7:PRINT "0";:COLOR ,0:PRINT CHR$(32);
  54. 630 FOR A=1 TO 15:COLOR A,0:PRINT HEX$(A);CHR$(32);:NEXT:PRINT
  55. 640 I$=INPUT$(1):IF INSTR("0123456789ABCDEFabcdef",I$)=0 THEN 610
  56. 650 PRINT TAB(VAL("&H"+I$)*2+34);CHR$(24)
  57. 660 PRINT STRING$(80,196);:RETURN
  58.