home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / DBT123S.ZIP / DBTVMENU.PRG < prev    next >
Text File  |  1990-07-22  |  6KB  |  143 lines
  1. * =====================================================================
  2. *  DBTVMENU.PRG - Vertical Bar Menu demo   V 1.23S
  3. *               (c) 1990 BERNATH COMPUTER
  4. *               07/20/1990
  5. * =====================================================================
  6. CALL DBTOOLS WITH "15,3"
  7. CALL DBTOOLS WITH "7,1,7,0,0"
  8. CALL DBTOOLS WITH "3,3,5,14,53,0,7,2,0,1"
  9. CALL DBTOOLS WITH "1,4,7,15,7,0,Vertical Bar Menu - function 20"
  10. SET COLOR TO N/W
  11. @  5,9 SAY "VMENU provides a vertical moving bar menu"
  12. @  6,9 SAY "in either a popup or non-popup style. The"
  13. @  7,9 SAY "menus are inside a framed and optionally"
  14. @  8,9 SAY "shadowed box. The arrow keys, or Home and"
  15. @  9,9 SAY "End highlight the desired menu item, and"
  16. @ 10,9 SAY "Enter selects it.  Alternatively, you may"
  17. @ 11,9 SAY "press the first letter of the menu item"
  18. @ 12,9 SAY "without pressing Enter."
  19. CALL DBTOOLS WITH "10,13,12,8,7"
  20.  
  21. CALL DBTOOLS WITH "3,5,10,22,75,15,0,2,0,0"
  22. CALL DBTOOLS WITH "1,6,20,0,7,0,NON-POPUP STYLE"
  23. mPARM = "CALL DBTOOLS WITH "+CHR(34)+"20,choice,0,ULR,ULC,LRR,LRC,LowFG,LowBG,"
  24.  
  25. set color to +w/n
  26. @ 7,12 say "Syntax:"
  27. @ 8,12 say mPARM
  28. mPARM = "frame,shadow,HighFG,HighBG,jus,"
  29. @ 9,31 SAY mPARM
  30. mPARM = "item1,item2,item3,....,@"+CHR(34)
  31. @ 10,31 say mPARM
  32. SET COLOR TO W/N
  33. @ 11,12 SAY "where: Choice is the initial choice to highlight."
  34. @ 12,12 SAY "       LowFG & LowBG are the colors for the non-highlighted"
  35. @ 13,12 SAY "       menu items, and HighFG & HighBG are the colors for"
  36. @ 14,12 SAY "       the highlighted menu items."
  37. @ 15,12 SAY "       Jus stands for Justification; Jus = 1, left justi-"
  38. @ 16,12 SAY "       fied, Jus = 2, text is centered."
  39. @ 17,12 SAY "       The other parameters are similar to those in Box,"
  40. @ 18,12 SAY "       function 3."
  41. CALL DBTOOLS WITH "10,21,28,0,7"
  42. CALL DBTOOLS WITH "7,1,7,0,0"
  43. CALL DBTOOLS WITH "3,1,5,6,70,15,7,1,0,1"
  44. SET COLOR TO +W/W
  45. @ 2,8 say "A string variable must be used to pass the parameters to"
  46. @ 3,8 say "the function, since the selected choice is returned in it."
  47. @ 4,8 SAY "Note that pressing ESC returns a value of 0."
  48. CALL DBTOOLS WITH "1,5,8,0,7,0,The example below illustrates how to use VMENU:"
  49. set color to +w/n
  50. CALL DBTOOLS WITH "3,8,13,15,74,15,0,1,0,0"
  51. @ 9,15 say "mCHOICE = 1"
  52. @ 10,15 SAY "mPARM = "+CHR(34)+"20,"+CHR(34)+"+STR(mCHOICE,2)+"+CHR(34)+"0,16,14,21,30,15,1,"+CHR(34)
  53. @ 11,15 SAY "mPARM=mPARM+"+CHR(34)+"1,1,1,3,1,Data Entry,Reports,Utilities,Quit,@"+CHR(34)
  54. @ 12,15 SAY "CALL DBTOOLS WITH mPARM"
  55. @ 13,15 SAY "mCHOICE = VAL(mPARM)"
  56. @ 14,15 SAY "DO CASE mCHOICE...... etc"
  57. mCHOICE = 1
  58. set color to W/N
  59. DO WHILE mCHOICE <> 0
  60.    CALL DBTOOLS WITH "1,18,3,14,0,0,Centered"
  61.    mPARM = "20,"+STR(mCHOICE,2)+",0,16,14,21,30,15,1,1,1,1,3,2,Data Entry,Reports,Utilities,Quit,@"
  62.    CALL DBTOOLS WITH mPARM
  63.    mCHOICE = VAL(mPARM)
  64.    @ 23,15 SAY "░"
  65.    CALL DBTOOLS WITH "5,23,15,23,37,2"
  66.    DO CASE
  67.       CASE mCHOICE = 1
  68.          CALL DBTOOLS WITH "1,23,15,15,2,0,Data Entry selected"
  69.       CASE mCHOICE = 2
  70.          CALL DBTOOLS WITH "1,23,15,15,2,0,Reports selected"
  71.       CASE mCHOICE = 3
  72.          CALL DBTOOLS WITH "1,23,15,15,2,0,Utilities selected"
  73.       CASE mCHOICE = 0 .OR. mCHOICE = 4
  74.          Mchoice = 0
  75.    ENDCASE
  76. ENDDO
  77. CALL DBTOOLS WITH "1,18,61,14,0,0,Left Justified"
  78. mPARM = "20,"+STR(mCHOICE,2)+",0,16,44,21,57,15,4,3,1,12,0,1,Data Entry,Reports,Utilities,Quit,@"
  79. CALL DBTOOLS WITH mPARM
  80.  
  81. CALL DBTOOLS WITH "21,3,8,25,19,72,14,5,1,1"
  82. CALL DBTOOLS WITH "1,9,40,14,5,0,POPUP Menus"
  83. SET COLOR TO +W/RB
  84. @ 11,27 SAY "To make a popup menu, first use the WINDOW"
  85. @ 12,27 SAY "function 21 to specify the coordinates of"
  86. @ 13,27 SAY "the box and save the screen data underneath."
  87. @ 14,27 SAY "Then use function 20 with the reduced param-"
  88. @ 15,27 SAY "eter set to activate the menu. The screen is"
  89. @ 16,27 SAY "restored with the UNPOP function 19."
  90. CALL DBTOOLS WITH "1,17,27,14,5,0,See the Main Demo Menu for a good example."
  91. CALL DBTOOLS WITH "10,18,35,7,4"
  92. CALL DBTOOLS WITH "19,3"
  93.  
  94. CALL DBTOOLS WITH "13,0,0,24,79,8,0"
  95. CALL DBTOOLS WITH "3,8,15,22,70,11,5,1,0,0"
  96. CALL DBTOOLS WITH "1,S,9,18,15,4,0,Function Key Trapping"
  97. SET COLOR TO +gb/RB
  98. @ 11,18 SAY "Menus also have the ability to trap and return the"
  99. @ 12,18 SAY "scancode values for Function Keys, by including the"
  100. @ 13,18 SAY "optional Y parameter:"
  101. CALL DBTOOLS WITH "1,14,26,15,5,0,Press F1 to change colors"
  102. mCHOICE = -1
  103. mFG = 15
  104. DO WHILE mCHOICE <> 0
  105.    IF mCHOICE = -1
  106.       mCHOICE = 1
  107.    ENDIF
  108.    mMENUSTR = "20,Y,"+STR(mCHOICE,2)+",0,17,25,21,40,"+STR(mFG,2)+",0,3,1,0,7,1,"
  109.    mMENUSTR = mMENUSTR+"1. Option 1,2. Option 2,Quit,@"
  110.    CALL DBTOOLS WITH mMENUSTR
  111.    mCHOICE = VAL(mMENUSTR)
  112.    DO CASE
  113.       CASE mCHOICE = 0 .OR. mCHOICE = 3
  114.          mCHOICE = 0
  115.       CASE mCHOICE = 1
  116.          CALL DBTOOLS WITH "1,15,26,14,5,0,Option 1 chosen."
  117.       CASE mCHOICE = 2
  118.          CALL DBTOOLS WITH "1,15,26,14,5,0,Option 2 chosen."
  119.       CASE mCHOICE = 99
  120.          mKEY=ASC(SUBSTR(mMENUSTR,4,1))-1
  121.          mSCAN=ASC(SUBSTR(mMENUSTR,5,1))-1
  122.          DO CASE
  123.             CASE mKEY=27 .AND. mSCAN=0               && ESC
  124.                 mCHOICE = 0
  125.             CASE mKEY=0 .AND. mSCAN=59               && F1 pressed
  126.                 mFG = mFG + 1
  127.                 IF mFG > 15
  128.                    mFG = 0
  129.                 ENDIF
  130.             OTHERWISE                           && Fkey other than F1
  131.                 mSTUFF="Scancodes are: "+STR(mKEY,3)+","+STR(mSCAN,3)
  132.                 CALL DBTOOLS WITH "1,15,26,14,5,0,"+mSTUFF
  133.          ENDCASE                                && mSCAN
  134.          mCHOICE = ASC(SUBSTR(mMENUSTR,6,1))
  135.    ENDCASE                                      && mCHOICE
  136.    IF mCHOICE = 0
  137.       EXIT
  138.    ENDIF
  139.  
  140. ENDDO
  141. CALL DBTOOLS WITH "14,3,0"
  142. RETURN
  143.