home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
q
/
qbmenu10.zip
/
QBMENU!.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-02-09
|
28KB
|
994 lines
' =================================================================
' >>>>>>>> QBMenu! 1.0
' <<<<<<<< (C) Copyright Victor Yiu, 1993.
' >>>>>>>> released February 9, 1993
' =================================================================
DECLARE SUB FlipTog (Position%)
DECLARE SUB Clock ()
DECLARE SUB Alarm ()
DECLARE SUB Center (Dummy%, Text$)
DECLARE SUB ClearBot ()
DECLARE SUB DrawTop (State%, Choice%)
DECLARE SUB DrawBox (StartX%, StartY%, EndX%, EndY%, Border%, Fill%, Shadow%)
DECLARE SUB Initialize ()
DECLARE SUB Info (Line1$, Line2$)
DECLARE SUB ModBG (Row%, Col%, Wid%, High%, State%)
DECLARE SUB Ok (X%, Y%, FCol%, BCol%, JustDraw%, Help25%)
DECLARE SUB ShowLogo (Offset%)
DECLARE SUB WaitFor (Leng%)
DECLARE FUNCTION AltOn% ()
DECLARE FUNCTION GetSubM$ ()
DECLARE FUNCTION Let2Scan% (Letter%)
DECLARE FUNCTION Main$ ()
DEFINT A-Z ' integers default
CONST False = 0, True = NOT False ' boolean
CONST RegF = 7, RegB = 0, RevF = 0, RevB = 7
CONST HighF = 15, HighB = 7, HighN = 0
CONST Closed = 1, Pressed = 2, Released = 3, Opened = 4, Search = -1
COMMON SHARED bBG%, ColorM%, VidSeg%, MonoVGA%
' $INCLUDE: 'SaveScrn.Bi'
DIM SHARED ProgName$, Help25%, Toggle$
DIM SHARED FalseAlt%, OldSta%, LastState%, PrevState%, Bar%
DIM SHARED LeftK$, RightK$, Up$, Down$
DIM SHARED Enter$, Null$, Escape$, Blank$
Initialize
COLOR 7, 0
CLS
COLOR 7, bBG
FOR BackGr = 2 TO 24
LOCATE BackGr, 1
PRINT STRING$(80, 177);
NEXT
COLOR 7, 1
Logo$ = "QBMenu! 1.0 ■ Victor Yiu ■ Fake app: just type a key... █ "
Logo$ = Logo$ + Logo$ + Logo$: ShiftPos = 2
ShowLogo 1
COLOR 7, 0
DrawBox 17, 3, 23, 78, 1, 32, 1
COLOR 12, 0
Center 18, "This is a sample menu from one of my software releases, WSMaker."
Center 19, "Try Option│Alphabetize -- it's a toggle! In fact, I put in 4 togs!"
Center 20, "Both PTable and WSMaker use a variation of this menu system."
COLOR 13, 0
Center 21, "Do you like it or hate it? Have a comment or suggestion? Want"
Center 22, "to include it in your app.? Just send me some mail..."
DrawTop Closed, 0
DO
In$ = Main ' just pertend that Main is INKEY$ and use it. It will
' return the SAME results. The difference is that Main
' will allow the user to pull down them menu!
SELECT CASE In$
CASE Escape$, Null$ + "k", Null$ ' Alt+F4 - escape: exit
Info "Thank you for trying QBMenu!", "(C) Copyright Victor Yiu, 1993."
COLOR 7, 0
CLS
END
CASE ELSE
ShowLogo ShiftPos
ShiftPos = (ShiftPos MOD 58) + 1
END SELECT
LOOP
LOCATE 1, 1, 1
COLOR 15, 0
CLS
END
' ==============================
MainMenu:
' use a "^" in front of a letter to make it the HOTKEY
DATA 4
'^ # of menus
DATA ^File
DATA ^Edit
DATA ^Options
DATA ^Help
FileDATA:
DATA 2, 15
' ^^^ co-ordinate for start box (row, col)
' v - how many lines long?
DATA 8, 22
' ^ - longest entry (the width of menu)
DATA 0
'^ how many toggles?
DATA ^New Puzzle
DATA ^Open Puzzle... F9
DATA ^Save F10
DATA Save ^As... Shift+F10
DATA ":
DATA ^Print... F8
DATA ":
DATA E^xit Alt+F4
EditDATA:
DATA 2, 21
DATA 6, 37
DATA 0
DATA ^Correct a Word... F3
DATA ^Remove a Word... Shift+F3
DATA ":
DATA ^Move a Word to a New Position... F4
DATA ":
DATA Edit ^Title... F5
OptionDATA:
DATA 2,27
DATA 10, 28
' +-------- total number of 'toggle entries' to read
' | +----- position in toggle$
' v v v-- position in toggle$
DATA 7, 1, 2, 3, 0, 0, 0, 4
' put a "0" for a menu choice that doesn't have a toggle.
' so if you have 3 menu choices, the 1st and 3rd are toggles,
' you would write:
' DATA 3, 1, 0, 2
' that is assuming that the 'toggles' represent the 1st and 2nd
' positions of the common shared string Toggle$ (that represents
' the current state of the toggles.)
DATA ^Alphabetize Words
DATA ^Easy Puzzle
DATA ^Confirm on Word Remove
DATA ":
DATA Save ^Options as Default F7
DATA ":
DATA Auto ^Screensaver
DATA ^Test Screensaver F6
DATA ":
DATA Send ^Form Feed to Printer
HelpDATA:
DATA 2, 32
DATA 4, 33
DATA 0
DATA ^How to use WSMaker 2.0 F1
DATA ^Command line parameters Ctrl+F1
DATA ":
DATA A^bout WSMaker 2.0 Shift+F1
Let2ScanDATA: ' do not change, please.
DATA 4
DATA 16,QWERTYUIOP[]
DATA 30,ASDFGHJKL;'
DATA 44,ZXCVBNM./
DATA 120,1234567890-=
SUB Alarm
SOUND 880, 1
SOUND 700, 1
DO: LOOP UNTIL LEN(INKEY$) = 0
END SUB
FUNCTION AltOn
DEF SEG = 0 ' bottom of mem.
IF (PEEK(1047) AND 8) THEN AltOn = True ELSE AltOn = False ' check for alt
DEF SEG ' return to current segment
END FUNCTION
SUB Center (Dummy, Text$)
IF LEN(Text$) = 80 THEN
LOCATE Dummy, 1
ELSE
LOCATE Dummy, (82 - LEN(Text$)) \ 2
END IF
PRINT Text$;
END SUB
SUB ClearBot
LOCATE 25, 1
IF ColorM THEN COLOR 15, 3 ELSE COLOR 0, 7
PRINT SPACE$(80);
END SUB
SUB Clock STATIC
IF OldTime$ <> TIME$ THEN
OldTime$ = TIME$
HourZ = VAL(TIME$)
IF HourZ > 12 THEN
T$ = MID$(STR$(HourZ - 12), 2) + MID$(TIME$, 3) + "pm"
ELSE
T$ = TIME$
IF LEFT$(T$, 1) = "0" THEN MID$(T$, 1) = Blank$
IF HourZ = 0 THEN T$ = "12" + MID$(T$, 3)
IF HourZ < 12 THEN T$ = T$ + "am" ELSE T$ = T$ + "pm"
END IF
LOCATE 1, 68, 0
COLOR 0, 7
PRINT CHR$(179); Blank$;
IF ColorM THEN COLOR 15, 7
PRINT T$;
END IF
END SUB
SUB DrawTop (State, Choice)
IF SCREEN(1, 3) <> 66 THEN ' first time init.
LOCATE 1, 1
IF ColorM THEN COLOR 15, 4 ELSE COLOR 15, 0
PRINT Blank$; LEFT$(ProgName$, 11); Blank$;
COLOR 7, 0
PRINT STRING$(81 - POS(0), 219);
END IF
RESTORE MainMenu
IF State <> Search THEN
LOCATE 1, 14
COLOR RevF, RevB
PRINT " ";
END IF
READ Num
SELECT CASE State
CASE Closed
FOR Dummy = 1 TO Num
READ A$
IF Dummy = Num THEN LOCATE , 62: PRINT Blank$;
HighWhere = INSTR(A$, Carrot$)
IF HighWhere <= 0 THEN
PRINT A$; " ";
ELSE
PRINT LEFT$(A$, HighWhere - 1); MID$(A$, HighWhere + 1); Blank$;
IF Dummy <> Num THEN PRINT Blank$;
END IF
NEXT
CASE Pressed
FOR Dummy = 1 TO Num
READ A$
HighWhere = INSTR(A$, Carrot$)
IF HighWhere <= 0 THEN HighWhere = LEN(A$) + 1
IF Dummy = Num THEN LOCATE , 63
COLOR RevF, RevB
PRINT LEFT$(A$, HighWhere - 1);
COLOR HighF, HighB
PRINT MID$(A$, HighWhere + 1, 1);
COLOR RevF, RevB
PRINT MID$(A$, HighWhere + 2); Blank$;
IF Dummy <> Num THEN PRINT Blank$;
NEXT
CASE Released
FOR Dummy = 1 TO Num
READ A$
HighWhere = INSTR(A$, Carrot$)
IF HighWhere <= 0 THEN HighWhere = LEN(A$) + 1
IF Dummy = Num THEN LOCATE , 62: COLOR RevF, RevB: PRINT Blank$;
IF Choice = Dummy THEN
LOCATE , POS(0) - 1
COLOR RegF, RegB
PRINT Blank$;
PRINT LEFT$(A$, HighWhere - 1);
COLOR HighF, HighN
PRINT MID$(A$, HighWhere + 1, 1);
COLOR RegF, RegB
PRINT MID$(A$, HighWhere + 2); Blank$;
IF Dummy <> Num THEN PRINT CHR$(219);
ELSE
COLOR RevF, RevB
PRINT LEFT$(A$, HighWhere - 1);
COLOR HighF, HighB
PRINT MID$(A$, HighWhere + 1, 1);
COLOR RevF, RevB
PRINT MID$(A$, HighWhere + 2); Blank$;
IF Dummy <> Num THEN PRINT Blank$;
END IF
NEXT
CASE Opened
FOR Dummy = 1 TO Num
READ A$
HighWhere = INSTR(A$, Carrot$)
IF HighWhere <= 0 THEN HighWhere = LEN(A$) + 1
IF Dummy <> Choice THEN
COLOR RevF, RevB
IF Dummy = Num THEN
LOCATE , 62
PRINT Blank$; LEFT$(A$, HighWhere - 1); MID$(A$, HighWhere + 1); Blank$;
ELSE
PRINT LEFT$(A$, HighWhere - 1); MID$(A$, HighWhere + 1); " ";
END IF
ELSE
IF Dummy = Num THEN LOCATE , 63
COLOR RegF, RegB
LOCATE , POS(0) - 1
PRINT Blank$; LEFT$(A$, HighWhere - 1); MID$(A$, HighWhere + 1); Blank$;
IF Dummy <> Num THEN PRINT CHR$(219);
END IF
NEXT
CASE Search
Choice = Choice AND 223 ' ucase it
Found = False
FOR Dummy = 1 TO Num
READ A$
HighWhere = INSTR(A$, Carrot$)
IF HighWhere > 0 THEN
IF ASC(UCASE$(MID$(A$, HighWhere + 1, 1))) = Choice THEN
Found = Dummy
EXIT FOR
END IF
END IF
NEXT
IF Found THEN Choice = Dummy ELSE Choice = 0
EXIT SUB
END SELECT
IF (LastState <> State) AND (State <> Search) THEN
ClearBot
SELECT CASE State
CASE Closed
Dummy$ = "Hold down <Alt> to open menu, <F1> for help, "
Center 25, Dummy$ + "directional keys to scroll list"
CASE Pressed
Center 25, "Press highlighted letter of menu or release <Alt> key"
CASE Released
Dummy$ = "Use arrow keys to navigate, a letter "
Center 25, Dummy$ + "or <Enter> to display menu, <Esc> to cancel"
CASE Opened
Dummy$ = "Use arrow keys to navigate, a letter "
Center 25, Dummy$ + "or <Enter> to execute, <Escape> to cancel"
CASE ELSE
END SELECT
Dummy$ = ""
LastState = State
END IF
COLOR 7, bBG
END SUB
SUB FlipTog (Position)
IF ASC(MID$(Toggle$, Position)) <> 0 THEN
MID$(Toggle$, Position) = Null$
ELSE
MID$(Toggle$, Position) = Blank$
END IF
END SUB
FUNCTION GetSubM$
' returns: X (Null$ if succesful) X (number selected)
'(Escape$ if abort)
'("<" or ">", for left and right respectively)
QuitLoop = False
Cursor = 1
READ StX, StY, Length, Longest
REDIM HighLight(1 TO Length), Scan(1 TO Length), ReturnVal$(1 TO Length)
Tog$ = STRING$(Length, 0)' internal tog, one for each one of elements,
' not "shared" one, when each blank is pre-set to
READ Togs ' different elements in different sub-menus.
IF Togs > 0 THEN
FOR Dummy = 1 TO Togs
READ TogPosition
IF TogPosition <> 0 THEN
MID$(Tog$, Dummy) = MID$(Toggle$, TogPosition, 1) 'not Null$
END IF ' if toggled
NEXT
END IF
IF ColorM THEN
Dummy = Snatch(Saved(), StX, StY, StX + Length + 2, StY + Longest + 5, Save)
ELSE
Dummy = Snatch(Saved(), StX, StY, StX + Length + 1, StY + Longest + 3, Save)
END IF
COLOR RevF, RevB
DrawBox StX, StY, StX + Length + 1, StY + Longest + 3, 1, 32, 1
' startX, End X, StartY, vv, 1 liner, fill with 32
' EndY (longest)
StartPos = StY + 2
SCol = StY + 1
Wid = Longest + 2
NextChoice = 1
FOR Dummy = 1 TO Length
READ Dummy$
IF ASC(Dummy$) <> 58 THEN
HighLight(Dummy) = INSTR(Dummy$, "^")
IF HighLight(Dummy) > 0 THEN
Scan(Dummy) = ASC(UCASE$(MID$(Dummy$, HighLight(Dummy) + 1)))
END IF
COLOR 0, 7
IF ASC(MID$(Tog$, Dummy, 1)) THEN
LOCATE StX + Dummy, SCol
PRINT CHR$(4);
ELSE
LOCATE StX + Dummy, StartPos
END IF
PRINT LEFT$(Dummy$, HighLight(Dummy) - 1); MID$(Dummy$, HighLight(Dummy) + 1);
ReturnVal$(Dummy) = CHR$(NextChoice)
NextChoice = NextChoice + 1
ELSE
LOCATE StX + Dummy, StY
PRINT CHR$(195); STRING$(Wid, 196); CHR$(180);
END IF
NEXT
Cursor = 1: OldC = 1
Attr = HighB * 16 + HighF
DEF SEG = VidSeg
Dummy = StX * 160 + SCol + SCol + 159
FOR X = 2 TO Length
IF LEN(ReturnVal$(X)) THEN POKE Dummy + HighLight(X) + HighLight(X), Attr
Dummy = Dummy + 160
NEXT
DEF SEG
Wid = Longest + 1
ModBG StX + Cursor, SCol, Wid, HighLight(Cursor), 1
Hold = AltOn
DO
GOSUB CheckKey
IF QuitLoop THEN EXIT DO
IF (OldC <> Cursor) THEN
ModBG StX + Cursor, SCol, Wid, HighLight(Cursor), 1
ModBG StX + OldC, SCol, Wid, HighLight(OldC), 0
OldC = Cursor
END IF
LOOP
Finish:
IF Okay THEN
GetSubM$ = Null$ + ReturnVal$(Cursor)
' number sucessful
END IF
' pop-down
Dummy = Snatch(Saved(), 0, 0, 0, 0, Rest)
EXIT FUNCTION
CheckKey:
DO
Alt = AltOn
IF PrevAlt AND (NOT Alt) THEN
IF NOT Hold THEN
GetSubM$ = Escape$: QuitLoop = True: RETURN
ELSE
Hold = False
END IF
END IF
PrevAlt = Alt
I$ = INKEY$
Clock
LOOP UNTIL LEN(I$)
SELECT CASE I$
CASE LeftK$
GetSubM$ = "<" + Null$' left
QuitLoop = True: RETURN
CASE RightK$
GetSubM$ = ">" + Null$' right
QuitLoop = True: RETURN
CASE Up$
DO
Cursor = Cursor - 1
IF Cursor < 1 THEN Cursor = Length
LOOP UNTIL LEN(ReturnVal$(Cursor)) ' not :
CASE Down$
DO
Cursor = Cursor + 1
IF Cursor > Length THEN Cursor = 1
LOOP UNTIL LEN(ReturnVal$(Cursor)) ' not :
CASE Escape$
GetSubM$ = Escape$ + Null$' abort
QuitLoop = True: RETURN
CASE Enter$
Okay = True
QuitLoop = True: RETURN
CASE ELSE ' look for scan
IF LEN(I$) = 1 THEN
Dummy = ASC(UCASE$(I$)): Start = Cursor
Cursor = 1
DO
IF HighLight(Cursor) > 0 THEN
IF Scan(Cursor) = Dummy THEN ' found
Okay = True
EXIT DO
END IF
END IF
Cursor = Cursor + 1
LOOP UNTIL Cursor > Length
IF NOT Okay THEN Alarm: Cursor = Start ELSE QuitLoop = True
ELSE
Dummy = ASC(RIGHT$(I$, 1)): Temp = Cursor
Cursor = 1
DO
IF HighLight(Cursor) > 0 THEN
IF Let2Scan(Scan(Cursor)) = Dummy THEN
Okay = True ' to enable trap for "successful"
EXIT DO
END IF
END IF
Cursor = Cursor + 1
LOOP UNTIL Cursor = Length
IF NOT Okay THEN Alarm: Cursor = Temp ELSE QuitLoop = True
END IF
END SELECT
RETURN
END FUNCTION
SUB Info (Line1$, Line2$)
IF LEN(Line2$) THEN
Line2 = True
IF LEN(Line2$) > LEN(Line1$) THEN
MaxLen = LEN(Line2$)
ELSE
MaxLen = LEN(Line1$)
END IF
ELSE
MaxLen = LEN(Line1$)
END IF
MaxLen = MaxLen + 4
IF MaxLen < 40 THEN MaxLen = 40
Start = 40 - MaxLen \ 2
Right = 80 - Start
Dummy = Snatch(Saved%(), 25, 1, 25, 80, Save)
Dummy = Snatch(Saved%(), 9, Start, 17 - Line2, Right + 2, Save)
IF ColorM THEN COLOR 15, 3 ELSE COLOR 0, 7
DrawBox 9, Start, 16 - Line2, Right, 2, 32, 1
Center 9, "╡ Information ╞"
Center 11, Line1$
IF Line2 THEN Center 12, Line2$
Ok 13 - Line2, 38, 15, 0, 0, 1
Dummy = Snatch(Saved(), 0, 0, 0, 0, Rest)
Dummy = Snatch(Saved(), 0, 0, 0, 0, Rest)
END SUB
SUB Initialize
LOCATE 1, 1, 0
PRINT Blank$
DEF SEG = 0
ColorM = (PEEK(&H410) AND 48) <> 48
DEF SEG
IF ColorM THEN VidSeg = &HB800 ELSE VidSeg = &HB000
Null$ = CHR$(0): BackSpace$ = CHR$(8): Tab$ = CHR$(9)
Enter$ = CHR$(13): Escape$ = CHR$(27): Blank$ = " " ' space
Up$ = Null$ + "H": Down$ = Null$ + "P"
LeftK$ = Null$ + "K": RightK$ = Null$ + "M"
Dummy = Let2Scan(0) ' initialize it.
' =========================
' Change your PROGRAM NAME here!
ProgName$ = "QBMenu! 1.0"
' =========================
Toggle$ = SPACE$(4)
MenuSysBy$ = "(C) Copyright Victor Yiu, 1993."
IF ColorM = 0 THEN
DEF SEG = &HB000
Dummy = PEEK(0)
IF PEEK(0) <> 89 THEN POKE 0, 89
IF (SCREEN(1, 1) <> 89) THEN VidSeg = &HB800: MonoVGA = True
DEF SEG
END IF
bBG = -ColorM ' blue background
Dummy = Snatch(Saved(), 0, 0, 0, MonoVGA, 10) ' initialize Snatch
END SUB
FUNCTION Let2Scan (Letter) STATIC
IF Init = 0 THEN
RESTORE Let2ScanDATA
READ Num
DIM Keys$(1 TO Num), Scans(1 TO Num)
FOR Init = 1 TO Num
READ Scans(Init), Keys$(Init)
NEXT
IF Letter = 0 THEN EXIT FUNCTION
END IF
T$ = UCASE$(CHR$(Letter))
FOR Find = 1 TO Num
Dummy = INSTR(Keys$(Find), T$)
IF Dummy THEN
Scans = Scans(Find) + Dummy - 1
EXIT FOR
END IF
NEXT
IF Scans = 0 THEN PRINT "Scan not found": BEEP: END
Let2Scan = Scans
END FUNCTION
FUNCTION Main$
Ex$ = Null$ + CHR$(10)
Cursor = 1: OldCur = 1
State = Closed
RESTORE MainMenu
READ MainMChoices
DO
DO
IF State <> OldSta THEN DrawTop State, Cursor
Alt = AltOn
IF Hold THEN IF NOT Alt THEN Hold = False: OldAlt = False
IF FalseAlt THEN
IF Alt THEN Alt = False ELSE FalseAlt = False
END IF
IF Alt THEN
IF (NOT OldAlt) AND (State = Closed) THEN
IF NOT Hold THEN
DrawTop Pressed, Cursor
State = Pressed
END IF
END IF
END IF
IF OldAlt THEN
IF (NOT Alt) AND (OldSta <> Opened) THEN
IF NOT Hold THEN
IF (State <> Closed) AND (State <> Pressed) THEN
DrawTop Closed, 0
State = Closed
ELSE
Cursor = 1
DrawTop Released, Cursor
State = Released
END IF
END IF
END IF
END IF
IF OldCur <> Cursor THEN ' moved
IF State = Opened THEN
DrawTop Opened, Cursor
ELSEIF State = Released THEN
DrawTop Released, Cursor
END IF
OldCur = Cursor
END IF
IF Alt <> OldAlt THEN OldAlt = Alt
OldSta = State
In$ = INKEY$
Clock
LOOP UNTIL LEN(In$)
K$ = In$
SELECT CASE In$
CASE RightK$
IF State = Released THEN
Cursor = Cursor + 1
IF Cursor > MainMChoices THEN Cursor = 1
ELSE
EXIT DO
END IF
CASE LeftK$
IF State = Released THEN
Cursor = Cursor - 1
IF Cursor < 1 THEN Cursor = MainMChoices
ELSE
EXIT DO
END IF
CASE Enter$, Blank$, Down$, Up$
IF State = Released THEN
GOSUB ActSub
ELSE
FalseAlt = True
EXIT DO
END IF
CASE Escape$
IF State <> Closed THEN
State = Closed
ELSE
EXIT DO
END IF
CASE ELSE
Found = False
IF LEN(In$) = 2 THEN
RESTORE MainMenu
READ Num
Dummy = ASC(RIGHT$(In$, 1))
FOR Temp = 1 TO Num
READ A$
HighWhere = INSTR(A$, Carrot$)
IF HighWhere > 0 THEN
IF Let2Scan(ASC(MID$(A$, HighWhere + 1))) = Dummy THEN
Cursor = Temp
Found = True
EXIT FOR
END IF
END IF
NEXT
ELSEIF Alt OR ((NOT Alt) AND (State = Released)) THEN 'len=1
Dummy = ASC(UCASE$(In$))
DrawTop Search, Dummy
IF Dummy > 0 THEN
Found = True
Cursor = Dummy
END IF
END IF
IF Found THEN
GOSUB ActSub
ELSE
IF (State = Closed) OR (State = Pressed) THEN
IF Alt THEN
FalseAlt = True
END IF
EXIT DO
ELSE
Alarm
END IF
END IF
END SELECT
LOOP
Main$ = K$
IF State <> Closed THEN DrawTop Closed, 0
EXIT FUNCTION
ActSub:
Dummy$ = "": OldSta = Opened: State = Opened
DO
DrawTop Opened, Cursor
' ===================================================================
' Here is the place that you edit to change what the menu choices
' do. All you have to do is change everything inside the
' "SELECT CASE Dummy." Do not change anything else.
' You may add identical procedures for every menu (like one for
' Search or Options, etc.)
' ===================================================================
SELECT CASE Cursor
CASE 1
RESTORE FileDATA
Dummy$ = GetSubM
IF ASC(Dummy$) = 0 THEN
ClearBot
Dummy = ASC(RIGHT$(Dummy$, 1))
SELECT CASE Dummy
' =================================================================
' This is MENU 1. Put a CASE {number} for every menu choice.
' CASE 1 is the first menu choice; CASE 2 is the second... etc.
' Separator bars do not count.
' =================================================================
CASE 6
Main$ = Null$
EXIT FUNCTION
CASE ELSE
Info "You picked Menu 1 Option" + STR$(Dummy), ""
END SELECT
END IF
CASE 2
RESTORE EditDATA
Dummy$ = GetSubM
IF ASC(Dummy$) = 0 THEN
ClearBot
Dummy = ASC(RIGHT$(Dummy$, 1))
SELECT CASE Dummy
' =================================================================
' This is MENU 2. Put a CASE {number} for every menu choice.
' CASE 1 is the first menu choice; CASE 2 is the second... etc.
' Separator bars do not count.
' =================================================================
CASE ELSE
Info "You picked Menu 2 Option" + STR$(Dummy), ""
END SELECT
END IF
CASE 3
RESTORE OptionDATA
Dummy$ = GetSubM
IF ASC(Dummy$) = 0 THEN
ClearBot
Dummy = ASC(RIGHT$(Dummy$, 1))
SELECT CASE Dummy
' =================================================================
' This is MENU 3. Put a CASE {number} for every menu choice.
' CASE 1 is the first menu choice; CASE 2 is the second... etc.
' Separator bars do not count.
' =================================================================
CASE 1, 2, 3, 5
FlipTog Dummy + (Dummy = 5)
Info "Flipping toggle!", "Go see for yourself!"
CASE ELSE
Info "You picked Menu 3 Option" + STR$(Dummy), ""
END SELECT
END IF
CASE 4
RESTORE HelpDATA
Dummy$ = GetSubM
IF ASC(Dummy$) = 0 THEN
Dummy = ASC(RIGHT$(Dummy$, 1))
ClearBot
SELECT CASE Dummy
' =================================================================
' This is MENU 4. Put a CASE {number} for every menu choice.
' CASE 1 is the first menu choice; CASE 2 is the second... etc.
' Separator bars do not count.
' =================================================================
CASE 2
Info "I've fallen, and I CAN'T get up!!!", ""
CASE 3
Info "QBMenu! 1.0 ■ Add-in Library", "(C) Copyright Victor Yiu, 1993."
CASE ELSE
Info "You picked Menu 4 Option" + STR$(Dummy), ""
END SELECT
END IF
END SELECT
SELECT CASE ASC(Dummy$)
CASE 62 ' ">"
Cursor = Cursor + 1
IF Cursor > MainMChoices THEN Cursor = 1
CASE 60 ' "<"
Cursor = Cursor - 1
IF Cursor < 1 THEN Cursor = MainMChoices
CASE ELSE
EXIT DO
END SELECT
LOOP
IF Dummy$ <> Escape$ THEN
State = Closed
Hold = AltOn
ELSE
State = Released
END IF
RETURN
END FUNCTION
SUB Ok (X, Y, FCol, BCol, JustDraw, Help25)
LOCATE , , 0
IF JustDraw <> Closed THEN
Dummy = Snatch(Saved(), X, Y, X + 2, Y + 5, Save)
COLOR FCol, BCol
GOSUB DrawOkBox
IF (FCol <= 7) AND (BCol = 0) AND (NOT ColorM) THEN COLOR FCol + 7
GOSUB DrawOk
IF Help25 THEN
Dummy = Snatch(Saved(), 25, 1, 25, 80, Save)
ClearBot
'IF ColorM THEN COLOR 15, 3 ELSE COLOR 0, 15
Center 25, "Press a key to continue"
END IF
IF JustDraw = Opened THEN EXIT SUB
DO: Clock: LOOP UNTIL LEN(INKEY$)
IF Help25 THEN
ClearBot
Dummy = Snatch(Saved(), 0, 0, 0, 0, Rest)
END IF
END IF
COLOR BCol, FCol
GOSUB DrawOkBox
IF (BCol <= 7) AND (FCol = 0) AND (NOT ColorM) THEN COLOR BCol + 7, FCol
GOSUB DrawOk
WaitFor 3
Dummy = Snatch(Saved(), 0, 0, 0, 0, Rest)
WaitFor 3
EXIT SUB
DrawOkBox:
DrawBox X, Y, X + 2, Y + 5, 1, 32, 0
RETURN
DrawOk:
LOCATE X + 1, Y + 2
PRINT "Ok";
RETURN
END SUB
SUB ShowLogo (Offset)
SHARED Logo$
COLOR 7, bBG
FOR Temp = 3 TO 15
LOCATE Temp, 5
PRINT MID$(Logo$, Offset + Temp, 70);
NEXT
END SUB
SUB WaitFor (Leng)
T! = TIMER
DO: LOOP UNTIL (TIMER - T!) > (Leng / 18) OR (TIMER < T!)
END SUB