'===========================================================================
' Subject: WINDOWING AND MENUING SYSTEM       Date: 11-10-95 (07:49)       
'  Author: Alexander Podkolzin                Code: PB                     
'  Origin: app@sbank.e-burg.su              Packet: MENU.ABC
'===========================================================================
'
' Simple windowing and menuing system, PowerBASIC.
' Author: Alexander Podkolzin  <APP@nw.sbank.e-burg.su>
' Public domain.
' You can modify the system easily, according to your
' preferences. Use it, as you want.
' I wrote these functions some years ago in TurboBASIC
' (Now i'm working with PB3.0). About 2 months ago I've
' slightly modified them and posted that demo to c.l.b.m.
' Source code was formatted by my program PBB.
'
'---------------------------------Demo here:-------------------------------
  DECLARE FUNCTION MenuItem(xb%,yb%,xe%,ye%,t%,b%,tn%,bn%,beg%) AS INTEGER
  DECLARE SUB PutAttribute(x%,y%,t%,b%)
  DECLARE SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
'--------------------------------------------------------------------------
  DEFINT a-z
  COLOR 12,1
  CLS
  LOCATE 7,24
  PRINT "Simple windowing and menuing system"
  LOCATE 9,16
  PRINT "Author: Alexander Podkolzin <APP@nw.sbank.e-burg.su>"
  Win 1,33,11,47,15,0,3                 ' Look at function header below...
  COLOR 0,3
  LOCATE 12,35 : PRINT "First  item"
  LOCATE 13,35 : PRINT "Second item"
  LOCATE 14,35 : PRINT "Third  item"
  i = MenuItem(34,12,46,14,0,3,14,0,1)  ' Look at function header...
  COLOR 7,1
  LOCATE 18,32
  PRINT "Your choice is "; i
  BEEP
  END
'--------------------------------------------------------------------------
' "MenuItem" returns an integer value, corresponding to line of your choice,
'            or -1, if ESC is pressed.
' Parameters:
' xb%,yb%,xe%,ye%  - the window coordinates, you choose items from;
' NOTE: Coordinates order is in C-manner!
'             t%   - text color,
'             b%   - background color of the window;
'             tn%  - text color,
'             bn%  - background color of cursor bar;
'             beg% - initial position of cursor.
'
'--------------------------------------------------------------------------
  FUNCTION MenuItem(xb%,yb%,xe%,ye%,t%,b%,tn%,bn%,beg%)
     LOCAL item%,s$,i%
     item%=yb%+beg%-1                   ' Initial settings
     FOR i%=xb% TO xe%
        CALL PutAttribute(i%,item%,tn%,bn%)
     NEXT i%
     DO
        s$=""
        WHILE s$ = ""
           s$ = INKEY$
        WEND
        IF LEN(s$) = 2 THEN
           IF MID$(s$,2,1)="H" THEN                  ' "Up" code
              FOR i%=xb% TO xe%
                 CALL PutAttribute(i%,item%,t%,b%)   ' Restore initial
              NEXT i%                                ' colors
              item%=item%-1
              IF item%<yb% THEN
                 item%=ye%
              END IF
              FOR i%=xb% TO xe%

                 CALL PutAttribute(i%,item%,tn%,bn%) ' Set new colors for
              NEXT i%                                ' cursor bar
           END IF
           IF MID$(s$,2,1)="P" THEN                  ' "Down" code
              FOR i%=xb% TO xe%
                 CALL PutAttribute(i%,item%,t%,b%)
              NEXT i%
              item%=item%+1
              IF item%>ye% THEN
                 item%=yb%
              END IF
              FOR i%=xb% TO xe%
                 CALL PutAttribute(i%,item%,tn%,bn%)
              NEXT i%
           END IF
        END IF
        i% = ASC(s$)
        IF i%=27 THEN                   ' "Esc" code
           MenuItem=-1
           GOSUB RestoreColor           ' Before EXIT we have
           EXIT FUNCTION                ' to restore colors
        END IF
        IF i%=13 THEN                   ' "Enter" code
           MenuItem=item%-yb%+1
           GOSUB RestoreColor
           EXIT FUNCTION
        END IF
     LOOP

RestoreColor:
     FOR i%=xb% TO xe%
        CALL PutAttribute(i%,item%,t%,b%)
     NEXT i%
     RETURN
  END FUNCTION
'--------------------------------------------------------------------------
  SUB PutAttribute(x%,y%,t%,b%)         ' Puts attribute byte to video memory
     LOCAL c%                           ' directly to Colomn, Row position
     c% = b%*16+t%                      '
     DEF SEG = &hb800                   ' NOTE: This is system depending !
     POKE 160*(y%-1)+x%+x%-1,c%
     DEF SEG
  END SUB
'--------------------------------------------------------------------------
' Sub Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
' Parameters:
' t%               - the window type,
' xb%,yb%,xe%,ye%  - the window coordinates,
' NOTE: Coordinates order is in C-manner!
'             ct%  - text color,
'             cb%  - background color of the window;
'
'--------------------------------------------------------------------------
  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
'--------------------------------------------------------------------------