home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / compiler / apbasic / example1.bas < prev    next >
Encoding:
BASIC Source File  |  1991-01-03  |  3.2 KB  |  155 lines
  1. '
  2. '    Example program using Menus, Windows and Traps
  3. '
  4. DefInt A-Z
  5. Const MaxOptions=3    ' Number of options in the menu
  6. Const Offset=5        ' Offset used in color test
  7. Dim WinA(1 to 4,1 to 5)    ' Four windows, 5 integers per window
  8.  
  9. ' Generate and return a random string
  10. Def RandomString$(Length)
  11.     Static Char
  12.     RandomString$=String$(Length,Char+32)
  13.     Incr Char
  14.     If Char>223 Then Char=0
  15. End Def
  16.  
  17. ' Sub program to center a title in a line
  18. Sub Center Title$,Row
  19.     Locate Row,40-Len(Title$)\2
  20.     Print Title$;
  21. End Sub
  22.  
  23. ' Sub program to make a window active
  24. Sub DoWin WindowNo
  25.     Window WinA(WindowNo,1),WinA(WindowNo,2),WinA(WindowNo,3),WinA(WindowNo,4)
  26.     Locate WinA(WindowNo,5),1    ' Restore cursor to correct row
  27.     Color WindowNo+1,0
  28.     Print RandomString$(34)
  29.     WinA(WindowNo,5)=CsrLin        ' Save row 
  30. End Sub
  31.  
  32. ' Return second expression if first is true else return third
  33. Def IfInt(Cond,E1,E2)
  34.     If Cond then
  35.       IfInt=E1
  36.     Else
  37.       IfInt=E2
  38.     End If
  39. End Def
  40.  
  41.     ' Main program loop
  42. Randomize Timer/3
  43. Gosub WindowSetup        ' Setup arrays for windows
  44. Do
  45.   Gosub PrintMenu
  46.   Gosub SelectOption
  47.   If Pointer=MaxOptions then End    ' Exit option is always last
  48.   On Pointer Gosub WindowTest, ColorTest
  49. Loop
  50.  
  51. WindowTest:
  52.     Cls
  53.     Center "Press any key to return to menu",25
  54.     While Inkey$=""
  55.       DoWin 1
  56.       DoWin 2
  57.       DoWin 3
  58.       DoWin 4
  59.     Wend
  60.     Color 7,0
  61.     Window 1,1,25,80
  62. Return
  63.  
  64. ColorTest:
  65.     Cls
  66.     Color 0,7
  67.     Center " Foreground Colors Available ",2
  68.     Color 7,0
  69.     For Colour=0 to 15
  70.       Window 1,1,25,80
  71.       Row=IfInt(Colour<8,0,8)
  72.       Col=IfInt(Colour<8,Colour,Colour-8)
  73.       Locate 4+Row,Offset+Col*9
  74.       Print "C=";Colour;
  75.       Window 5+row,Col*9+Offset,5+Row+6,Col*9+Offset+5
  76.       Color Colour,0
  77.       Print String$(48,"█");
  78.       Color 7,0
  79.     Next Colour
  80.     Window 1,1,25,80
  81.     Center "Press any key to continue",24
  82.     While Inkey$="" : Wend
  83. Return
  84.  
  85. SelectOption:
  86.     C$=""
  87.     Do
  88.         C$=Inkey$
  89.     Loop while C$=""
  90.     If C$=Chr$(13) then Return    ' user selected an option
  91.     If Left$(C$,1)<>Chr$(0) then Goto SelectOption    ' Not function key
  92.     C=Asc(Right$(C$,1))        ' Move extended char code to numeric
  93.     If C=72 then        ' Up cursor
  94.       Decr Pointer
  95.     ElseIf C=80 then    ' Down cursor
  96.       Incr Pointer
  97.     ElseIf C=71 then    ' Home
  98.       Pointer=1
  99.     ElseIf C=79 then    ' End
  100.       Pointer=MaxOptions
  101.     Else
  102.       Goto SelectOption
  103.     End If
  104.     Gosub UpdatePointer    ' move pointer
  105.     Goto SelectOption
  106.  
  107. PrintMenu:
  108.     Cls
  109.     Color 0,7
  110.     Center "  Example Program  ",2
  111.     Color 7,0
  112.     Locate 12,10
  113.     Print "Use the up and down cursor keys to point to a function.";
  114.     Locate 13,10
  115.     Print "Press <Enter> to execute the function.";
  116.     Locate 7,34
  117.     Print "Window Test";
  118.     Locate 8,34
  119.     Print "Color Test";
  120.     Locate 9,34
  121.     Print "Exit program";
  122.     Pointer=1
  123.     OldPointer=1
  124.     Gosub UpdatePointer
  125. Return
  126.  
  127. UpdatePointer:
  128.     If Pointer>MaxOptions then Pointer=1
  129.     If Pointer<1 then Pointer=MaxOptions
  130.     Locate 6+OldPointer,30
  131.     Print "   ";
  132.     Locate 6+Pointer,30
  133.     Print "» »";
  134.     OldPointer=Pointer
  135. Return
  136.  
  137. ' Setup Window() array
  138. WindowSetup:
  139.         ' Window #1
  140.     Data 1,1,10,35,1
  141.         ' Window #2
  142.     Data 1,45,10,80,1
  143.         ' Window #3
  144.     Data 15,1,24,35,1
  145.         ' Window #4
  146.     Data 15,45,24,80,1
  147.     Restore WindowSetup
  148.     For Wcounter=1 to 4
  149.       For Coor=1 to 5
  150.        Read WinA(Wcounter,Coor)
  151.       Next
  152.     Next
  153. Return
  154.  
  155.