'===========================================================================
' Subject: COLOR CHOOSER                      Date: 11-22-95 (07:27)       
'  Author: Alexander Podkolzin                Code: PB                     
'  Origin: app@sbank.e-burg.su              Packet: MISC.ABC
'===========================================================================
'---------------------------------------------------------------------------
'
' It's a TOY, wich will help users to write a subroutine to choose
' colors for their APP@lications.   :)
' This little toy is my Christmas present to all ABC readers...
' Use & enjoy.
' Author: Alexander Podkolzin <APP@sbank.e-burg.su>
' Public domain.
'
'---------------------------------------------------------------------------
  DEFINT A-Z
  CLS
'
  xb%=20         '  <<^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^>>
  yb%=10         '  << I think we don't need comments here...  >>
  xe%=xb%+34     '  <<                                         >>
  ye%=yb%+9      '  << Your comments and kisses send to author >>
  ct%=7          '  <<    dayly from 8.30 to 17.30 GMT-5 :))   >>
  cb%=0          '  <<_________________________________________>>
'
  LOCATE ye%+2,19
  PRINT "Use navigation keys for cursor moving..."
  Enter$    = CHR$(13)
  Esc$      = CHR$(27)
  Home$     = CHR$(0,71)
  PgUp$     = CHR$(0,73)
  EndKey$   = CHR$(0,79)
  PgDn$     = CHR$(0,81)
  Up$       = CHR$(0,72)
  Down$     = CHR$(0,80)
  LeftKey$  = CHR$(0,75)
  RightKey$ = CHR$(0,77)
  Ch%= 2 '10                   ' Cursor face
  Hc%= 7                    '
'
  px%=xe%-2                 ' Cursor pointers
  py%=ye%-1                 '
  win 1,xb%,yb%,xe%,ye%,ct%,cb%
  FOR i%=0 TO 7
     PutAttribute xb%+1,yb%+i%+1,0,i%
     FOR j%=0 TO 15
        PutChar xb%+j%+j%+2,yb%+i%+1,CHR$(Hc%)
        PutAttribute xb%+j%+j%+2,yb%+i%+1,j%,i%
        PutAttribute xb%+j%+j%+3,yb%+i%+1,j%,i%
     NEXT j%
  NEXT i%
  PutChar px%,py%,CHR$(Ch%)
  DO
     ctext%=(px%-xb%)\2 -1
     cback%=py%-yb% -1
     ColorFrame xb%,yb%,xe%,ye%,ctext%,cback%
     WHILE NOT INSTAT: WEND
     s$=INKEY$
     PutChar px%,py%,CHR$(Hc%)
     SELECT CASE s$
        CASE Enter$    : CLS
                       : COLOR ctext%,cback%
                       : PRINT "Congratulations !"
                       : PRINT "Your favorite colors are:";
                       : PRINT ctext%;"- Text Color,";
                       : PRINT cback%;"- Background Color."
                       : END
        CASE Esc$      : CLS: PRINT "Bye-bye!": END
        CASE Home$     : px%=xb%+2
        CASE EndKey$   : px%=xe%-2
        CASE PgUp$     : py%=yb%+1
        CASE PgDn$     : py%=ye%-1
        CASE Up$       : DECR py%
        CASE Down$     : INCR py%
        CASE LeftKey$  : DECR px%,2
        CASE RightKey$ : INCR px%,2
     END SELECT
     IF px%<xb%+2 THEN px%=xe%-2
     IF px%>xe%-2 THEN px%=xb%+2
     IF py%<yb%+1 THEN py%=ye%-1
     IF py%>ye%-1 THEN py%=yb%+1
     PutChar px%,py%,CHR$(Ch%)
     SOUND 440+cback%*32+ctext%*32,.2
  LOOP
'---------------------------------------------------------------------------
  SUB PutChar(x%,y%,c$)
     DEF SEG = &hb800                   ' WARNING: System dependent !
     POKE 160*(y%-1)+x%+x%-2,ASC(c$)
     DEF SEG
  END SUB
'---------------------------------------------------------------------------
  SUB PutAttribute(x%,y%,t%,b%)
     c% = b%*16+t%
     DEF SEG = &hb800                   ' WARNING: System dependent !
     POKE 160*(y%-1)+x%+x%-1,c%
     DEF SEG
  END SUB
'---------------------------------------------------------------------------
  SUB ColorFrame(xb%,yb%,xe%,ye%,t%,b%)
     FOR i%=xb% TO xe%
        PutAttribute i%,yb%,t%,b%
        PutAttribute i%,ye%,t%,b%
     NEXT i%
     FOR i%=yb% TO ye%
        PutAttribute xb%,i%,t%,b%
        PutAttribute xe%,i%,t%,b%
     NEXT i%
  END SUB
'---------------------------------------------------------------------------
  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
'
     OldColor% = pbvScrnTxtAttr         ' Internal PB variable
'
     SELECT CASE t%                     ' Window types
'                                       ' (you can make as much types,
'                                       '  as you want):
        CASE 1
           a%=218:b%=196:c%=191         '���������
           h%=179: :d%=179              '�   1   �
           g%=192:f%=196:e%=217         '���������
        CASE 2
           a%=201:b%=205:c%=187         '���������
           h%=186: :d%=186              '�   2   �
           g%=200:f%=205:e%=188         '���������
        CASE ELSE
           a%=032:b%= a%:c%= a%         '
           h%= a%: :d%= a%              ' Blanks only
           g%= a%:f%= a%:e%= a%         '
     END SELECT
     COLOR ct%,cb%
     LOCATE yb%,xb% : PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%)
     FOR i%=yb%+1 TO ye%-1
        LOCATE i%,xb% : PRINT CHR$(h%)+ SPACE$(xe%-xb%-1) +CHR$(d%)
     NEXT
     LOCATE ye%,xb% : PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%)
     FOR i%=yb%+1 TO ye%+1
        PutAttribute xe%+1,i%,8,0       ' Maiking
     NEXT                               ' shadows
     FOR i%=xb%+1 TO xe%+1              '
        PutAttribute i%,ye%+1,8,0       '
     NEXT
     ct%=OldColor% AND 15               ' restore colors
     cb%=OldColor%\16
     COLOR ct%,cb%
  END SUB
'--------------------------------------------------------------------------