home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library3 / colorset.bas < prev    next >
BASIC Source File  |  1990-09-08  |  11KB  |  318 lines
  1.  
  2.  DEFINT A-Z
  3.  CLS
  4.  ScrColor = &H02
  5.  BoxColor = &H4E
  6.  
  7.  LOCATE ,,0
  8.  
  9. '   Code to write Static Window {colorset} to Screen
  10. '        note: created by StatWindow Writer (SWW) from colorset.SW
  11.  
  12.  COLOR BoxColor MOD 16, BoxColor \ 16
  13.  LOCATE  3, 5
  14.  PRINT "┌───────────────────────────────────────────────────────────────────┐"
  15.  LOCATE  4, 5
  16.  PRINT "│                                                                   │";
  17.  LOCATE  5, 5
  18.  PRINT "│     COLORSET is a part of the HB All-Purpose library for Power    │";
  19.  LOCATE  6, 5
  20.  PRINT "│     Basic programming. One of the features included is making     │";
  21.  LOCATE  7, 5
  22.  PRINT "│     your PB programs color-customizable by the end user.          │";
  23.  LOCATE  8, 5
  24.  PRINT "│     COLORSET.BAS, once compiled,  automates the process of        │";
  25.  LOCATE  9, 5
  26.  PRINT "│     writing command line switches to reset the colors of the      │";
  27.  LOCATE  10, 5
  28.  PRINT "│     Demo (or any PB program that uses the SetColors routine).     │";
  29.  LOCATE  11, 5
  30.  PRINT "│     Start it and follow directions! The program will end up       │";
  31.  LOCATE  12, 5
  32.  PRINT "│     writing a batch file (name is entered at runtime) to start    │";
  33.  LOCATE  13, 5
  34.  PRINT "│     a PB exe file (likewise) in the colors chosen onscreen.       │";
  35.  LOCATE  14, 5
  36.  PRINT "│                                                                   │";
  37.  LOCATE  15, 5
  38.  PRINT "│         (Thanks to Barry Erick of Spectra support for giving his  │";
  39.  LOCATE  16, 5
  40.  PRINT "│     OK to recycle his elegant color selector procedure as the     │";
  41.  LOCATE  17, 5
  42.  PRINT "│     kernel of COLORSET.)                                          │";
  43.  LOCATE  18, 5
  44.  PRINT "│                                             -- Howard Ballinger   │";
  45.  LOCATE  19, 5
  46.  PRINT "│                                                    9-8-90         │";
  47.  LOCATE  20, 5
  48.  PRINT "│      PRESS ANY KEY                                                │";
  49.  LOCATE  21, 5
  50.  PRINT "│      [Esc] to Quit                                                │";
  51.  LOCATE  22, 5
  52.  PRINT "└───────────────────────────────────────────────────────────────────┘";
  53.  
  54. '  09-08-1990, 11:13:   end of StatWindow generated code for window {colorset}
  55.  
  56.  COLOR ScrColor MOD 16, ScrColor \ 16
  57.  DO: K$ = INKEY$: LOOP UNTIL K$ <> ""
  58.  IF K$ = CHR$ (27) THEN PRINT: PRINT: PRINT "OK, Ending Here.": STOP
  59.  
  60.  ScrColor = &H02
  61.  WinColor = &H71
  62.  FldColor = &H2F
  63.  MenuColor = &H03
  64.  BarColor = &H1F
  65.  BoxColor = &H3A
  66.  
  67. Start:
  68.  COLOR ScrColor MOD 16, ScrColor \ 16
  69.  CLS: LOCATE 12,5: PRINT "THIS IS THE SCREEN BACKGROUND COLOR"
  70.  LOCATE 2,20: PRINT "COLOR SELECT FOR HB / POWER BASIC PROGRAMS"
  71.  LOCATE 3,21: PRINT "========================================"
  72.  
  73.  LOCATE 19,25: PRINT "╔══════╗
  74.  LOCATE 20,25: PRINT "║BUTTON║
  75.  LOCATE 21,25: PRINT "╚══════╝
  76.  
  77.  COLOR MenuColor MOD 16, MenuColor \ 16
  78.  LOCATE 14,3: PRINT "╔═ sample menu ═╗"
  79.  LOCATE 15,3: PRINT "║ 1 - Machaut   ║"
  80.  LOCATE 16,3: PRINT "║ 2 - Lassus    ║"
  81.  LOCATE 17,3: PRINT "║ 3 - Des Prez  ║"
  82.  LOCATE 18,3: PRINT "║ 4 - Palestrina║"
  83.  LOCATE 19,3: PRINT "║ 5 - Holborne  ║"
  84.  LOCATE 20,3: PRINT "║ 6 - Tallis    ║"
  85.  LOCATE 21,3: PRINT "╚═══════════════╝"
  86.  
  87.  
  88.  COLOR BarColor MOD 16, BarColor \ 16
  89.  LOCATE 15,4: PRINT " 1 - Machaut   "
  90.  
  91.  COLOR WinColor MOD 16, WinColor \ 16
  92.  LOCATE 14,37: PRINT "╔═══════════════════════════════════╗
  93.  LOCATE 15,37: PRINT "║     SAMPLE DATA ENTRY WINDOW      ║
  94.  LOCATE 16,37: PRINT "║                                   ║
  95.  LOCATE 17,37: PRINT "║  Year: 1610    Form: Gaillard     ║
  96.  LOCATE 18,37: PRINT "╚═══════════════════════════════════╝
  97.  
  98.  COLOR FldColor MOD 16, FldColor \ 16
  99.  LOCATE 17, 46: PRINT "1610"
  100.  LOCATE 17, 60: PRINT "Gaillard   "
  101.  
  102.  COLOR BoxColor MOD 16, BoxColor \ 16
  103.  LOCATE 20,48: PRINT "╔═════════════════════╗
  104.  LOCATE 21,48: PRINT "║ SAMPLE MESSAGE BOX  ║
  105.  LOCATE 22,48: PRINT "╚═════════════════════╝
  106.  
  107.  
  108.  LOCATE 24,1
  109.  COLOR 15,0
  110.  PRINT "  1: Menu / 2: Menu Select Bar / 3: Window / 4: Data Fields in Window        ";
  111.  LOCATE 25,1
  112.  PRINT "     5: Message-Dialog Boxes / 6: Screen Background & Buttons / [Esc]: QUIT   ";
  113.  
  114.  LOCATE 23,1,1: COLOR 14,0: PRINT "Which color do you want to set ? ";
  115.  DO
  116.    Choice$ = INKEY$
  117.    IF Choice$ = "" THEN Choice$ = "0"
  118.  LOOP UNTIL (INSTR ("123456", Choice$) >  0) OR Choice$ = CHR$(27)
  119.  
  120.  LOCATE 23,1,0: PRINT "                                       "
  121.  LOCATE 24,1: PRINT SPACE$ (79);
  122.  LOCATE 25,1: PRINT SPACE$ (79);
  123.  SELECT CASE Choice$
  124.    CASE "1"
  125.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU COLOR";
  126.       F = MenuColor MOD 16: B = MenuColor \ 16
  127.       GOSUB GetChoice
  128.       MenuColor = F + 16*B
  129.       EXIT SELECT
  130.    CASE "2"
  131.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU SELECTION BAR COLOR";
  132.       F = BarColor MOD 16: B = BarColor \ 16
  133.       GOSUB GetChoice
  134.       BarColor = F + 16*B
  135.       EXIT SELECT
  136.    CASE "3"
  137.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY WINDOW COLOR";
  138.       F = WinColor MOD 16: B = WinColor \ 16
  139.       GOSUB GetChoice
  140.       WinColor = F + 16*B
  141.       EXIT SELECT
  142.    CASE "4"
  143.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY FIELD COLOR";
  144.       F = FldColor MOD 16: B = FldColor \ 16
  145.       GOSUB GetChoice
  146.       FldColor = F + 16*B
  147.       EXIT SELECT
  148.    CASE "5"
  149.       LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MESSAGE / DIALOG BOX COLOR";
  150.       F = BoxColor MOD 16: B = BoxColor \ 16
  151.       GOSUB GetChoice
  152.       BoxColor = F + 16*B
  153.       EXIT SELECT
  154.    CASE "6"
  155.       LOCATE 24,10: COLOR 31,0
  156.       PRINT "SELECT YOUR OVERALL SCREEN & BUTTON COLOR";
  157.       F = ScrColor MOD 16: B = ScrColor \ 16
  158.       GOSUB GetChoice
  159.       ScrColor = F + 16*B
  160.       EXIT SELECT
  161.    CASE CHR$ (27)
  162.       LOCATE 5,1
  163.       L$ = "ScrC="+FnHEX2$ (ScrColor)+_
  164.        " MnuC="+FnHEX2$ (MenuColor)+_
  165.        " BarC="+FnHEX2$ (BarColor)+_
  166.        " WinC="+FnHEX2$ (WinColor)+_
  167.        " FldC="+ FnHEX2$ (FldColor)+_
  168.        " BoxC="+FnHEX2$ (BoxColor)
  169.       PRINT "the parameter string is: ";L$
  170.       COLOR ScrColor MOD 16, ScrColor \ 16
  171. PrepareBatFile:
  172.       LOCATE 6,1
  173.       PRINT "  IF YOU WANT TO CREATE A BATCH FILE, ENTER ITS NAME (no ext) "
  174.       INPUT "      (TO SKIP, JUST PRESS [ENTER]). FileName ";BatName$
  175.       IF BatName$ <> "" THEN
  176.         P = INSTR (BatName$, ".")
  177.         IF P THEN BatName$ = LEFT$ (BatName$, P-1)
  178.         BatName$ = UCASE$ (LEFT$ (BatName$, 8))
  179.         LOCATE 8,1
  180.         PRINT "  NAME OF POWER-BASIC EXE PROGRAM TO BE STARTED IN NEW COLORS"
  181.         PRINT "    BY THE BATCH FILE ";BatName$ + ".BAT ?? (no ext) ";
  182.         INPUT ExeName$
  183.         P = INSTR (ExeName$, ".")
  184.         IF P THEN ExeName$ = LEFT$ (ExeName$, P-1)
  185.         ExeName$ = LEFT$ (ExeName$, 8)
  186.         IF ExeName$ = BatName$ THEN
  187.           LOCATE 8,10
  188.           PRINT "THE FILE NAMES CAN'T BE THE SAME ";
  189.           PRINT "OR DOS WON'T KNOW WHICH ONE TO START !"
  190.           PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
  191.           GOTO Start
  192.         END IF
  193.         ON ERROR GOTO Oops
  194.         OPEN BatName$ + ".BAT" FOR OUTPUT AS #1
  195.         PRINT #1, "echo off"
  196.         PRINT #1, ExeName$ + " " + L$
  197.         PRINT #1, ":   this batch file created by SETCOLOR.BAS to run " + ExeName$
  198.         CLOSE #1
  199.         ON ERROR GOTO 0
  200.         LOCATE 10,20: PRINT "FILE CREATED"
  201.       END IF
  202.       LOCATE 25,79
  203.       STOP
  204.  
  205.  END SELECT
  206.  
  207.  GOTO Start
  208.  
  209. DEF FnHEX2$ (N)
  210.  IF N < &H10 THEN FnHEX2$ = "0" + HEX$(N) ELSE FnHEX2$ = HEX$ (N)
  211. END DEF
  212. '      __________________________________________________________
  213.  
  214. GetChoice:
  215.  DO
  216.    IF F = B OR (F = 8 AND B = 0) THEN INCR F
  217.    COLOR 15,0
  218.    CALL GetUserColorChoice (F,B)
  219.    COLOR F, B: LOCATE 16,20: PRINT F,B
  220.    IF F = B OR (F = 8 AND B = 0) THEN
  221.      LOCATE 11,10: COLOR 15,1: PLAY "O3 MS B16 G16"
  222.      PRINT " OOPS! Your combination,";F;"&";B;", is INVISIBLE. Try again ... "
  223.    ELSE
  224.      LOCATE 12,10: COLOR 0,0: PRINT SPACE$ (65)
  225.    END IF
  226.  LOOP WHILE F = B OR (F = 8 AND B = 0)
  227.  RETURN
  228.  
  229. SUB GetUserColorChoice(Fore%,Back%)
  230. '                                     (c) 1988 Barry Erick
  231. '                                         used by presumption -- thanks
  232.  FirstY% = 2   'MAX is 17 MIN is 2
  233.  FirstX% = 3   'MAX is 16 MIN is 1
  234. ' CLS
  235.  Fore% = Fore% MOD 17
  236.  back% = back% MOD 9
  237.  If Fore% <0 THEN Fore% = 0
  238.  If Back% < 0 THEN Back% = 0
  239.  FirstY% = FirstY% MOD 18
  240.  IF FirstY%<2 THEN FirstY%=2
  241.  FirstX% = FirstX% MOD 17
  242.  IF FirstX%<1 THEN FirstX%=1
  243.  Title$ = "Move with "+CHR$(24)+CHR$(25)+CHR$(26)+CHR$(27)+"; <Enter> Selects"
  244.  Title$ = "BARRY'S COLOR CHART. " + Title$
  245.  LOCATE FirstY%-1,(32-(LEN(Title$)/2))
  246.  PRINT title$;
  247.  LOCATE FirstY%,FirstX%
  248.  FOR Y% = 0 TO 7
  249.      FOR X% = 0 TO 15
  250.          COLOR  X%,Y%
  251.          PRINT " XX ";
  252.      NEXT
  253.      LOCATE CSRLIN+1,FirstX%
  254.  NEXT
  255.  UsersFirstX%=(Fore%*4)+FirstX%
  256.  usersFirstY%=Back%+FirstY%
  257.  LOCATE UsersFirstY%,UsersFirstX%
  258.  Cline% = CSRLIN
  259.  Ps%=POS
  260.  Oldcline%=Cline%
  261.  Oldps%=Ps%
  262.  COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
  263.  PRINT " XX ";
  264.  
  265.  DO
  266.      WHILE NOT INSTAT:WEND
  267.      A$=INKEY$
  268.      IF LEN(A$)=1 THEN
  269.         SELECT CASE A$
  270.                CASE CHR$(13)
  271. ' this one
  272.                     Fore%=(Oldps%\4)-(FirstX%\4)
  273.                     Back%=Oldcline%-FirstY%
  274.                     IF FirstY%>13 THEN
  275.                        LOCATE 2,1
  276.                     ELSE
  277.                        LOCATE FirstY%+9,1
  278.                     END IF
  279.                     EXIT LOOP
  280.         END SELECT
  281.      ELSEIF LEN(A$)=2 THEN
  282.         SELECT CASE ASC(RIGHT$(A$,1))
  283.                CASE 72 'up arrow
  284.                     IF CSRLIN >FirstY% THEN
  285.                        DECR Cline%
  286.                     END IF
  287.                CASE 75 'left arrow
  288.                     IF POS >FirstX%+4 THEN
  289.                        DECR Ps%,4
  290.                     END IF
  291.                CASE 77 'right arrow
  292.                     IF POS <FirstX%+61 THEN
  293.                        INCR Ps%,4
  294.                     END IF
  295.                CASE 80 ' down arrow
  296.                     IF CSRLIN < FirstY%+7 THEN
  297.                        INCR Cline%
  298.                     END IF
  299.         END SELECT
  300.      END IF
  301.      LOCATE Oldcline%,Oldps%
  302.      COLOR ((Oldps%\4)-(FirstX%\4)),Oldcline% -FirstY%
  303.      PRINT " XX ";
  304.      COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
  305.      Oldcline% = Cline%
  306.      Oldps%=Ps%
  307.      LOCATE Cline%,Ps%
  308.      PRINT  " XX ";
  309.  LOOP
  310.  
  311. END SUB
  312.  
  313. Oops:
  314.  LOCATE 8,1: PRINT "ERROR OPENING FILE ";BatName$
  315.  PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
  316.  RESUME Start
  317.  
  318.