home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progbas
/
apb16.arj
/
EXAMPLE1.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-01-03
|
3KB
|
155 lines
'
' Example program using Menus, Windows and Traps
'
DefInt A-Z
Const MaxOptions=3 ' Number of options in the menu
Const Offset=5 ' Offset used in color test
Dim WinA(1 to 4,1 to 5) ' Four windows, 5 integers per window
' Generate and return a random string
Def RandomString$(Length)
Static Char
RandomString$=String$(Length,Char+32)
Incr Char
If Char>223 Then Char=0
End Def
' Sub program to center a title in a line
Sub Center Title$,Row
Locate Row,40-Len(Title$)\2
Print Title$;
End Sub
' Sub program to make a window active
Sub DoWin WindowNo
Window WinA(WindowNo,1),WinA(WindowNo,2),WinA(WindowNo,3),WinA(WindowNo,4)
Locate WinA(WindowNo,5),1 ' Restore cursor to correct row
Color WindowNo+1,0
Print RandomString$(34)
WinA(WindowNo,5)=CsrLin ' Save row
End Sub
' Return second expression if first is true else return third
Def IfInt(Cond,E1,E2)
If Cond then
IfInt=E1
Else
IfInt=E2
End If
End Def
' Main program loop
Randomize Timer/3
Gosub WindowSetup ' Setup arrays for windows
Do
Gosub PrintMenu
Gosub SelectOption
If Pointer=MaxOptions then End ' Exit option is always last
On Pointer Gosub WindowTest, ColorTest
Loop
WindowTest:
Cls
Center "Press any key to return to menu",25
While Inkey$=""
DoWin 1
DoWin 2
DoWin 3
DoWin 4
Wend
Color 7,0
Window 1,1,25,80
Return
ColorTest:
Cls
Color 0,7
Center " Foreground Colors Available ",2
Color 7,0
For Colour=0 to 15
Window 1,1,25,80
Row=IfInt(Colour<8,0,8)
Col=IfInt(Colour<8,Colour,Colour-8)
Locate 4+Row,Offset+Col*9
Print "C=";Colour;
Window 5+row,Col*9+Offset,5+Row+6,Col*9+Offset+5
Color Colour,0
Print String$(48,"█");
Color 7,0
Next Colour
Window 1,1,25,80
Center "Press any key to continue",24
While Inkey$="" : Wend
Return
SelectOption:
C$=""
Do
C$=Inkey$
Loop while C$=""
If C$=Chr$(13) then Return ' user selected an option
If Left$(C$,1)<>Chr$(0) then Goto SelectOption ' Not function key
C=Asc(Right$(C$,1)) ' Move extended char code to numeric
If C=72 then ' Up cursor
Decr Pointer
ElseIf C=80 then ' Down cursor
Incr Pointer
ElseIf C=71 then ' Home
Pointer=1
ElseIf C=79 then ' End
Pointer=MaxOptions
Else
Goto SelectOption
End If
Gosub UpdatePointer ' move pointer
Goto SelectOption
PrintMenu:
Cls
Color 0,7
Center " Example Program ",2
Color 7,0
Locate 12,10
Print "Use the up and down cursor keys to point to a function.";
Locate 13,10
Print "Press <Enter> to execute the function.";
Locate 7,34
Print "Window Test";
Locate 8,34
Print "Color Test";
Locate 9,34
Print "Exit program";
Pointer=1
OldPointer=1
Gosub UpdatePointer
Return
UpdatePointer:
If Pointer>MaxOptions then Pointer=1
If Pointer<1 then Pointer=MaxOptions
Locate 6+OldPointer,30
Print " ";
Locate 6+Pointer,30
Print "» »";
OldPointer=Pointer
Return
' Setup Window() array
WindowSetup:
' Window #1
Data 1,1,10,35,1
' Window #2
Data 1,45,10,80,1
' Window #3
Data 15,1,24,35,1
' Window #4
Data 15,45,24,80,1
Restore WindowSetup
For Wcounter=1 to 4
For Coor=1 to 5
Read WinA(Wcounter,Coor)
Next
Next
Return