home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
pb
/
library4
/
menus-u.bas
< prev
next >
Wrap
BASIC Source File
|
1990-09-16
|
19KB
|
577 lines
'==============================================================================
' THE NEW IMPROVED MENUS-U.BAS
'==============================================================================
' -- 2-18-90
$COMPILE UNIT
$ERROR ALL OFF
DEFINT A-Z
EXTERNAL RD$, VideoSeg&, ColorDisplay, NeedDCon
EXTERNAL BoxColor, FldColor, WinColor, MenuColor, BarColor
EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
EXTERNAL ButtonsActive, TimeOut
EXTERNAL BXScreenSaved, PMScreenSaved
EXTERNAL MenuHelpLine$()
EXTERNAL UseRArrow, UseLArrow, UsePgUp, UsePgDn, PullDown
%False = 0
%True = NOT %False
%ButtonsDefined = 0
%ResetRodent = 0 ' mouse routine and humor (??) courtesy of Barry Erick
%ReadRodent = 3
%LeftButton = 1
%RightButton = 2
%Wht = 15
%MouseVertSensit = 1 ' controls mouse sensitivity in POPMENU
%MouseHorizSensit = 10 ' controls mouse sensitivity in POPMENU
%MouseIcon = 15 ' ... a little sun or bug character
%MaxMenuWidth = 40
' MENU RETURN CODES (KEY PRESSED.)
%CR = 0: %Esc = &H20: %F1 = &H100: %F2 = &H200
%PgUp = &H400: %PgDn = &H600
%RArrow = &H800: %LArrow = &HA00
DECLARE SUB Mouse (integer, integer, integer, integer)
' ----------------------------------------------------------------------------
SUB TOPMENU (Lines% ,Choice, TLine$) PUBLIC
LOCAL I$(), K$(), Choices%, D$, LEach, L, SpacesLeftOver, I%, B$, Att,_
Choice$, Click, Ln, Col, RefTime&
STATIC mcsrX, mcsrY
IF %ButtonsDefined THEN ButtonActive = %False
TReadlines:
DIM I$(6): DIM K$(6)
Choices% = 0
READ D$
DO WHILE D$ <> "END"
INCR Choices%
I$(Choices%) = D$
K$(Choices%) = LEFT$(D$,1)
READ D$
LOOP
LOCATE ,,0
TSetVars:
IF Choice = 0 THEN Choice = 1
LEach = 80\Choices%
SpacesLeftOver = 80 - Choices% * LEach
FOR I% = 1 TO Choices% ' create menu elements
B$ = I$(I%)
L = ((LEach - LEN(B$))/2) + 1: IF L<2 THEN L=2 ' fixed 12-88
I$(I%) = SPACE$(LEach)
MID$ (I$(I%), L) = B$
IF SpacesLeftOver THEN I$(I%) = I$(I%)+" ": DECR SpacesLeftOver
NEXT I%
' making their total length = 80 chrs
COLOR MenuColor MOD 16, MenuColor \ 16
LOCATE 25,1: PRINT "CHOOSE MAIN PROGRAM FUNCTION FROM TOP ROW.";
PRINT " USE ARROWS TO SELECT THEN PRESS [CR]";
DEF SEG = VideoSeg&
POKE 3998, ASC("."): POKE 3999,PEEK (3997)
DEF SEG ' menu borders & help line printed
LOCATE 1,1
IF Lines% > 2 THEN PRINT STRING$ (80, 205)
IF TLine$ <> "" THEN LOCATE 1, (40 - LEN(TLine$)\2): PRINT TLine$;
TDisp:
Att = 16
GOSUB TPrint ' print menu elements
COLOR MenuColor MOD 16, MenuColor \ 16
IF Lines% > 1 THEN LOCATE 3,1:PRINT STRING$ (80, 205)
TGetChoice:
IF NeedDCon THEN
Cheese = 0
Choice$ = ""
DEF SEG = VideoSeg&
StoredChr = PEEK (Addr): StoredAttr = PEEK (Addr+1)
DO
CALL Mouse (%ReadRodent, Click, mcsrX, mcsrY)
IF Addr <> mcsrX/4 + 160*INT(mcsrY/8) THEN
POKE Addr, StoredChr
POKE Addr+1, StoredAttr
Addr = mcsrX/4 + 160*INT(mcsrY/8)
StoredChr = PEEK (Addr)
StoredAttr = PEEK (Addr+1)
POKE Addr, %MouseIcon ' move the mouse cursor if nec.
POKE Addr+1, %Wht OR PEEK (Addr+1)
END IF
IF (Click = %LeftButton) AND (mcsrY < 60) THEN ' you clicked on top bar:
Choice = INT (mcsrX * Choices% / 640) + 1 ' so move cursor ...
Att = 16
GOSUB TPrint ' & reprint menu elements
IF mcsrY > 0 AND mcsrY < 30 THEN
Choice$ = CHR$(13)
POKE Addr, StoredChr
POKE Addr+1, StoredAttr
EXIT LOOP
END IF
END IF
IF ButtonsDefined THEN ' ---------------------------|
IF Click AND mcsrY > 112 THEN
Ln = mcsrY / 8 + 1 ' 8 mickeys per line
Col = mcsrX / 8 + 1 ' 8 mickeys per column
IF Ln > 18 AND Ln < 25 THEN
IF Col > 8 AND Col < 23 THEN ButtonActive = %DirButton: EXIT LOOP
IF Col > 30 AND Col < 44 THEN ButtonActive = %TreeButton: EXIT LOOP
END IF
IF (Ln > 14 AND Ln < 18) AND (Col > 68 AND Col < 75) THEN _
ButtonActive = %HelpButton: EXIT LOOP
END IF
END IF ' ----------------------------------|
IF TimeOut AND (TIMER > RefTime& + TimeOut) THEN
TimeUp = %True
EXIT LOOP
END IF
LOOP UNTIL INSTAT
' LPRINT "ButtonActive ="; ButtonActive
IF Choice$ = "" THEN Choice$ = INKEY$
DEF SEG
ELSE
DO
IF TimeOut AND (TIMER > RefTime& + TimeOut) THEN
TimeUp = %True
EXIT LOOP
END IF
LOOP UNTIL INSTAT
' ****************
Choice$ = INKEY$ ' ** GET KEYSTROKE **
' ****************
END IF
IF TimeUp OR ButtonActive THEN BEEP:BEEP: Choice = 1 : GOTO TDone
IF LEN(Choice$) > 1 THEN ' you pressed an arrow key ...
SELECT CASE RIGHT$(Choice$,1)
CASE CHR$(&H4D)
GOSUB TRightArrow
CASE CHR$(&H4B)
GOSUB TLeftArrow
CASE CHR$(&H50)
Choice$ = CHR$(13)
CASE CHR$(59)
TLine$ = "HELP!"
GOTO TDone
CASE ELSE
GOTO TError
END SELECT
END IF
IF Choice$ = CHR$(13) THEN Choice$ = K$(Choice): GOTO TDone
IF Choice$ = CHR$(27) THEN Choice = Choices%: GOTO TDone
Choice$ = UCASE$(Choice$)
FOR I = 1 TO Choices%
IF Choice$ = K$(I) THEN Choice = I:GOTO TDone
NEXT
GOTO TError
TError:
PLAY OopsBeep$
GOTO TGetChoice
TLeftArrow:
DECR Choice
IF Choice < 1 THEN Choice = Choices%
RETURN TDisp
TRightArrow:
INCR Choice
IF Choice > Choices% THEN Choice = 1
RETURN TDisp
TDone:
Att = 0: GOSUB TPrint
TLine$ = RTRIM$ (LTRIM$ (I$ (Choice)))
LOCATE ,,1
EXIT SUB
TPrint:
LOCATE Lines%-1,1
' IF Choice < 1 OR Choice > Choices% THEN Choice = 1
FOR I% = 1 TO Choices%
IF I% = Choice THEN
COLOR Att + (BarColor MOD 16), BarColor \ 16
ELSE
COLOR MenuColor MOD 16, MenuColor \ 16
END IF
PRINT I$(I%);
NEXT
RETURN
END SUB REM TOPMENU
' ==============================================================================
SUB POPMENU (TopKey$,MenuRight,MenuDown,Choice,MLine$,MCode$) PUBLIC
' ====
LOCAL Choices%, D$,A$, Maxx, Title$, MKeyPressed$, PopRead$ ()
DIM DYNAMIC PopRead$ (24)
MReadlines:
Choices% = 0: A$ = ""
READ D$ ' read 2 $'s- the menu line & the assoc. memo
DO WHILE D$ <> "END" AND A$ <> "END" ' (from data list)
READ A$
IF Choices% < 24 THEN INCR Choices% ' count 1 item
PopRead$(Choices%) = D$
IF TopKey$ <> "" THEN PopRead$(Choices%) = " " + PopRead$(Choices%)
MenuHelpLine$(Choices%) = A$ ' plug arrays --
READ D$ ' ... longest $ is
LOOP
PopRead$ (Choices% + 1) = "END"
Title$ = MLine$
CALL SUPERMENU (PopRead$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
MCode$ = MenuHelpLine$(Choice)
MLine$ = PopRead$ (Choice)
ERASE PopRead$
END SUB REM POPMENU
'______________________________________________________________________________
SUB SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%) PUBLIC
' ====
'
' ===================
'
' BRIEF SYNTAX: MenuData$ () ARRAY holds items in menu
'
' ferexample, MenuData$ (1) = "L LOAD" (pressing L will select)
' or ... MenuData$ (1) = " LOAD" (pressing 1 will select)
'
' After all menu lines are defined, the next array item must be "END"
'
' MenuRight may be >0 for right of center, <0 for left.
' MenuDown = 0 places menu at screen top; >24 centers it.
'
' Choice is usually set as 1 before calling menu
'
' Title$ is just a menu title
'
'
'
'*** AFTER SUPERMENU CALL: Choice will hold the choice # (according to array passed)
'
' Ky% will encode the key used to exit the menu process --
' %CR, %Esc, %PgUp, %PgDn, %RArrow, %LArrow, %F1, %F2
'
' (PgUp key will only function if the global var UsePgUp = %Yes, and
' similarly for the others. If there is another page, cursoring or
' mousing past the bottom of the displayed page will simulate
' pressing PgDn, etc. All these globals are reset to %False after exit,
' but UseF1 isn't.
'
LOCAL Choices%, D$, A$, K$(), Longest, HelpLines, TopKey
LOCAL Wid, Height, K$, CornerLin, CornerCol, N, C
DIM K$ (24)
Ky% = 0
' ======= START; GET WIDTH OF ITEMS AND HOW MANY ===============
LOCATE ,,0
ArrayNum = 1
DO UNTIL UCASE$ (RTRIM$ (LTRIM$ (MenuData$(ArrayNum) ))) = "END"
INCR Choices%
IF LEN (RTRIM$ (MenuData$(ArrayNum))) > Longest THEN_
Longest = LEN (RTRIM$ (MenuData$(ArrayNum)))
'keep track of how long the items are ...
K$ (ArrayNum) = LEFT$ (MenuData$ (ArrayNum), 1)
IF MenuHelpLine$ (ArrayNum) <> "" THEN INCR HelpLines
INCR ArrayNum
LOOP
DECR Longest, 2 ' clip off the 2 chrs which are not part of the item
' ==================== DO CALCULATIONS FOR MENU ===========================
MSetVars:
VCentered = (MenuDown > 23) ' trap hi MenuDown value
Wid = Longest + 6 ' compute box size --
Height = Choices%+2
MenuDown = MAX% (0, MenuDown)
MenuDown = MIN% ((23-Choices%), MenuDown)
MenuRight = MIN% ((40 - Wid\2), MenuRight)
MenuRight = MAX% (-39, MenuRight)
CornerCol = INT((80-Wid)/2 + MenuRight)' & the top left corner --
CornerCol = MAX% (1, CornerCol)
CornerLin = INT(1 + MenuDown)
CornerLin = MAX% (1, CornerLin)
IF VCentered THEN CornerLin = (24-Height)/2 + 1 ' trap hi MenuDown value
IF TopKey$ <> "" THEN TopKey = ASC(TopKey$)' (means center vertically)
BAR$ = "\"+SPACE$(Wid-8)+"\"
Choice = MAX% (1, Choice)
Choice = MIN% (Choices% , Choice)
IF LEFT$ (MenuData$ (1), 1) = " " THEN
IF Choices% > 10 THEN TopKey = ASCII ("A") ELSE TopKey = ASCII ("1")
END IF
MPrint:
L0 = CSRLIN: C0 = POS
COLOR MenuColor MOD 16, MenuColor \ 16
' =================== BEGIN PRINTING MENU =====================
LOCATE CornerLin,CornerCol: PRINT CHR$(201); STRING$((Wid-1),205); CHR$(187)
IF MLine$ <> "" THEN LOCATE CornerLin,CornerCol+2: PRINT " ";MLine$;" "
' top of menu frame is complete
' print menu lines
FOR N = 1 TO Choices%
IF TopKey > 0 THEN K$ (N) = CHR$(TopKey-1+N)
LOCATE N+CornerLin, CornerCol
PRINT CHR$(186); " "; K$(N); " - ";
PRINT USING BAR$; MID$(MenuData$(N),3); : PRINT CHR$(186);
NEXT
' print bottom bar
LOCATE N+CornerLin,CornerCol:PRINT CHR$(200); STRING$((Wid-1),205); CHR$(188);
IF PullDown THEN ' hold here if clicking ...
Click = %False
DO
IF NeedDCon THEN CALL Mouse (%ReadRodent, Click, X, Y)
IF Y0 = 0 THEN Y0 = Y
IF Click THEN
IF Y - Y0 > %MouseVertSensit THEN
MouseNotMoved = %False ' unless mouse moved down.
EXIT LOOP
ELSE
MouseNotMoved = %True
END IF
END IF
LOOP WHILE Click
IF MouseNotMoved THEN Choice = 0: GOTO ExitMenu
END IF
GOSUB DrawHighlightedBar
MGetChoice:
DO ' ********************************
Click = %False ' ** GET KEYSTROKE OR MOUSE INPUT **
WasClick = %False ' ********************************
Choice$ = ""
DO
IF NeedDCon THEN
CALL Mouse (%ReadRodent, Click, X, Y)
IF Click THEN
IF Click >= %RightButton THEN
Choice$ = CHR$(27)
EXIT LOOP
END IF
IF WasClick THEN
IF X - X0 > %MouseHorizSensit THEN
Choice$ = CHR$(0) + CHR$ (&H4D)
ELSEIF X0 - X > %MouseHorizSensit THEN
Choice$ = CHR$(0) + CHR$ (&H4B)
ELSEIF Y - Y0 > %MouseVertSensit THEN
Choice$ = CHR$(0) + CHR$ (&H50)
ELSEIF Y0 - Y > %MouseVertSensit THEN
Choice$ = CHR$(0) + CHR$ (&H48)
END IF
END IF
X0 = X: Y0 = Y: WasClick = Click
ELSE
IF WasClick THEN
Choice$ = CHR$(13)
FOR I = 1 TO 5 ' this builds in a slight
DELAY .05 ' delay (1/4 sec.) after
CALL Mouse (%ReadRodent, Click, X, Y) ' mouse button is released
IF Click >= %RightButton THEN ' during which the right
Choice$ = CHR$(27) ' (cancel) button can be
EXIT FOR ' pressed if you change
END IF ' your mind.
NEXT
ELSE
Choice$ = UCASE$(INKEY$)
END IF
END IF
ELSE
Choice$ = UCASE$(INKEY$)
END IF
OldChoice = Choice
LOOP UNTIL Choice$ <> ""
' ======================== CHOICE HAS BEEN MADE ...
SELECT CASE Choice$
CASE CHR$ (0 ) + CHR$(&H48 )
GOSUB MUpArrow
CASE CHR$ (0 ) + CHR$(&H50 )
GOSUB MDownArrow
CASE CHR$ (0 ) + CHR$(&H4B )
IF UseLArrow THEN GOSUB MLArrow
CASE CHR$ (0 ) + CHR$(&H4D )
IF UseRArrow THEN GOSUB MRArrow
CASE CHR$ (0 ) + CHR$(&H3B )
GOSUB MF1Key
' deleted CASE CHR$ (0 ) + CHR$(&H3C )
' deleted GOSUB MF2Key
CASE CHR$ (0 ) + CHR$(&H49 )
IF UsePgUp THEN GOSUB MPgUpKey
CASE CHR$ (0 ) + CHR$(&H51 )
IF UsePgDn THEN GOSUB MPgDnKey
CASE CHR$(13)
Choice$ = K$(Choice) ' you pressed [CR]
CASE CHR$(27)' you pressed [ESC]. Sets return var as 0 and exits.
' First erase the highlighted bar by rewriting it ...
COLOR MenuColor MOD 16, MenuColor \ 16
LOCATE (Choice+CornerLin),(CornerCol+1)
PRINT " ";K$(Choice);" - ";
PRINT USING BAR$;MID$(MenuData$(Choice),3);
Choice = 0
Ky% = %Esc
EXIT LOOP ' --------------------------------------------------------
END SELECT
' & chose Choice$
' Your entry is checked vs. list of K$'s, If it's valid
' then Choice is set appropriately.
FOR I = 1 TO Choices%
IF Choice$ = K$(I) THEN Choice = I: EXIT LOOP
NEXT
LOOP
ExitMenu:
IF Choice > 0 THEN GOSUB MoveBar
MenuDown = 0: MenuRight = 0
UsePgUp = 0: UsePgDn = 0: UseRArrow = 0: UseLArrow = 0: PullDown = 0
FOR N = 1 TO Choices%: MenuHelpLine$(N) = "": NEXT
LOCATE L0,C0,1
EXIT SUB
MoveBar:
COLOR MenuColor MOD 16, MenuColor \ 16 ' NOTE: THIS IS ONE
LOCATE (OldChoice+CornerLin),(CornerCol+1) ' OF THOSE DREADED
PRINT " ";K$(OldChoice);" - "; ' TWO-HEADED SUB-
PRINT USING BAR$;MID$(MenuData$(OldChoice),3); ' ROUTINES. MoveBar
' RUNS RIGHT INTO
DrawHighlightedBar: ' DrawHighLightedBar!
COLOR BarColor MOD 16, BarColor \ 16 ' (works just Fine!)
LOCATE (Choice + CornerLin),(CornerCol+1)
PRINT " ";K$(Choice);" - ";
PRINT USING BAR$;MID$(MenuData$(Choice),3);
'' print bottom line on screen
IF HelpLines THEN GOSUB MClearLine
IF LEN(MenuHelpLine$(Choice)) > 9 THEN
MenuHelpLine$(Choice) = Left$(MenuHelpLine$(Choice), 78) ' trap long ln
COLOR MenuColor MOD 16, BarColor \ 16
LOCATE 25, (41-LEN(MenuHelpLine$(Choice))/2)
PRINT MenuHelpLine$(Choice);
END IF
RETURN
MUpArrow:
DECR Choice
IF Choice < 1 THEN
IF PullDown THEN
' an up-arrow when the bar is at
Choice = 0 ' the top will clear the menu
RETURN ExitMenu
ELSEIF UsePgUp THEN
Ky% = %PgUp
RETURN ExitMenu
ELSE
Choice = Choices%
END IF
END IF
GOSUB MoveBar: RETURN
MDownArrow:
INCR Choice
IF Choice > Choices% THEN
IF PullDown THEN
DECR Choice
ELSEIF UsePgDn THEN
' erase the highlighted bar by rewriting it ...
COLOR MenuColor MOD 16, MenuColor \ 16
DECR Choice
LOCATE (Choice + CornerLin), (CornerCol+1)
PRINT " "; K$ (Choice); " - ";
PRINT USING BAR$; MID$ (MenuData$ (Choice), 3);
Choice = 0
Ky% = %PgDn
RETURN ExitMenu
ELSE
Choice = 1
END IF
' IF PullDown THEN DECR Choice ELSE Choice = 1
END IF
GOSUB MoveBar: RETURN
MF1Key:
Ky% = %F1
Choice = 0 ' just as if ESC had been pressed
RETURN ExitMenu
MF2Key:
Ky% = %F2
RETURN ExitMenu
MPgUpKey:
Ky% = %PgUp
RETURN ExitMenu
MPgDnKey:
Ky% = %PgDn
RETURN ExitMenu
MRArrow:
Ky% = %RArrow
RETURN ExitMenu
MLArrow:
Ky% = %LArrow
RETURN ExitMenu
MClearLine:
LOCATE 25,1
PRINT STRING$ (80," ");
RETURN
END SUB REM SUPERMENU