home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / DBT123S.ZIP / DBTHMENU.PRG < prev    next >
Text File  |  1990-07-22  |  6KB  |  133 lines
  1. * =====================================================================
  2. *  DBTHMENU.PRG - Horizontal Bar Menu demo    V1.23S
  3. *               (c) 1990 BERNATH COMPUTER
  4. *               07/21/1990
  5. * =====================================================================
  6. CALL DBTOOLS WITH "15,3"
  7. CALL DBTOOLS WITH "7,1,7,0,0"
  8. CALL DBTOOLS WITH "3,3,5,13,53,0,7,2,0,1"
  9. CALL DBTOOLS WITH "1,4,7,8,7,0,Horizontal Bar Menu - function 9"
  10. SET COLOR TO N/W
  11. @ 5,9 SAY "HMENU provides a horizontal moving bar"
  12. @ 6,9 SAY "menu in the style of Lotus 123. Use of"
  13. @ 7,9 SAY "the arrow keys or Home and End highlights"
  14. @ 8,9 SAY "the desired menu item, and Enter selects"
  15. @ 9,9 SAY "it.  Alternatively, you may press the"
  16. @ 10,9 say "first letter of the menu item without"
  17. @ 11,9 SAY "pressing Enter."
  18. CALL DBTOOLS WITH "10,12,12,8,7"
  19.  
  20. CALL DBTOOLS WITH "3,6,10,22,75,15,0,2,0,0"
  21. mPARM = "CALL DBTOOLS WITH "+CHR(34)+"9,<Y>,choice,row,col,LowFG,LowBG,"
  22.  
  23. set color to +w/n
  24. @ 7,12 say "Syntax:"
  25. @ 8,12 say mPARM
  26. mPARM = "HighFG,HighBG,item1,item2,....,@"+CHR(34)
  27. @ 9,31 SAY mPARM
  28. SET COLOR TO W/N
  29. @ 11,12 SAY "where: Choice is the initial choice to highlight"
  30. @ 13,12 SAY "       LowFG & LowBG are the colors for the non-highlighted"
  31. @ 14,12 SAY "       menu items."
  32. @ 16,12 SAY "       HighFG & HighBG are the colors for the highlighted"
  33. @ 17,12 SAY "       menu items."
  34. @ 19,12 SAY "       There can be as many menu items as will fit across"
  35. @ 20,12 SAY "       one screen line, terminated by the @ character."
  36. CALL DBTOOLS WITH "10,21,28,0,7"
  37. CALL DBTOOLS WITH "3,6,10,22,75,15,0,2,0,0"
  38. @ 7,15 say "A string variable must be used to pass the parameters to"
  39. @ 8,15 say "the function, since the selected choice is returned in it."
  40. @ 9,15 SAY "Note that pressing ESC returns a value of 0."
  41. @ 11,15 say "The example below illustrates how to use HMENU:"
  42. set color to +w/n
  43. @ 13,15 say "mCHOICE = 1"
  44. @ 14,15 SAY "mPARM = "+CHR(34)+"9,"+CHR(34)+"+STR(mCHOICE,2)+"+CHR(34)+",20,25,7,1,1,7,"+CHR(34)
  45. @ 15,15 SAY "mPARM=mPARM+"+CHR(34)+"Add,Change,Delete,Quit,@"+CHR(34)
  46. @ 16,15 SAY "CALL DBTOOLS WITH mPARM"
  47. @ 17,15 SAY "mCHOICE = VAL(mPARM)"
  48. @ 18,15 SAY "DO CASE mCHOICE...... etc"
  49. mCHOICE = 1
  50. DO WHILE mCHOICE <> 0
  51.    mPARM = "9,"+STR(mCHOICE,2)+",20,25,7,1,1,7,Add,Change,Delete,Quit,@"
  52.    CALL DBTOOLS WITH mPARM
  53.    mCHOICE = VAL(mPARM)
  54.    @ 20,55 SAY " "
  55.    CALL DBTOOLS WITH "5,20,55,20,70,0"
  56.    DO CASE
  57.       CASE mCHOICE = 1
  58.          CALL DBTOOLS WITH "1,20,55,15,2,0,Add selected"
  59.       CASE mCHOICE = 2
  60.          CALL DBTOOLS WITH "1,20,55,15,2,0,Change selected"
  61.       CASE mCHOICE = 3
  62.          CALL DBTOOLS WITH "1,20,55,15,2,0,Delete selected"
  63.       CASE mCHOICE = 0 .OR. mCHOICE = 4
  64.          Mchoice = 0
  65.    ENDCASE
  66. ENDDO
  67.  
  68. CALL DBTOOLS WITH "13,0,0,24,79,8,0"
  69. CALL DBTOOLS WITH "3,8,15,22,70,14,2,1,0,0"
  70. CALL DBTOOLS WITH "1,S,9,18,10,1,0,Function Key Trapping"
  71. SET COLOR TO +W/G
  72. @ 11,18 SAY "Menus also have the ability to trap and return the"
  73. @ 12,18 SAY "scancode values for Function Keys, by including the"
  74. @ 13,18 SAY "optional Y parameter:"
  75. CALL DBTOOLS WITH "1,14,26,0,2,0,Press F1 for popup help."
  76. mCHOICE = -1
  77. mFG = 15
  78. DO WHILE mCHOICE <> 0
  79.    IF mCHOICE = -1
  80.        mCHOICE = 1
  81.    ENDIF
  82.    mMENUSTR = "9,Y,"+STR(mCHOICE,2)+",18,25,14,2,10,0,"
  83.    mMENUSTR = mMENUSTR+"1. Option 1  ,2. Option 2  ,Quit,@"
  84.    CALL DBTOOLS WITH mMENUSTR
  85.    mCHOICE = VAL(mMENUSTR)
  86.    DO CASE
  87.       CASE mCHOICE = 0 .OR. mCHOICE = 3
  88.          mCHOICE = 0
  89.       CASE mCHOICE = 1
  90.         * gNUMOPT = mCHOICE
  91.          CALL DBTOOLS WITH "1,15,26,14,2,0,Option 1 chosen."
  92.       CASE mCHOICE = 2
  93.         * gNUMOPT = mCHOICE
  94.          CALL DBTOOLS WITH "1,15,26,14,2,0,Option 2 chosen."
  95.       CASE mCHOICE = 99                         && Fkey was pressed
  96.          mKEY  = ASC(SUBSTR(mMENUSTR,4,1))-1    && 1st scancode
  97.          mSCAN = ASC(SUBSTR(mMENUSTR,5,1))-1    && 2nd scancode
  98.          mOPT = ASC(SUBSTR(mMENUSTR,6,1))    && highlighted option
  99.          mCHOICE = mOPT
  100.          DO CASE
  101.             CASE mKEY=27 .AND. mSCAN=0          && ESC
  102.                 mCHOICE = 0
  103.             CASE mKEY=0 .AND. mSCAN=59          && F1 pressed
  104.                 DO CASE
  105.                    CASE mOPT = 1
  106.                       CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
  107.                       CALL DBTOOLS WITH "1,8,47,0,3,0,This is popup help for"
  108.                       CALL DBTOOLS WITH "1,9,47,0,3,0,Option 1!"
  109.                       CALL DBTOOLS WITH "10,12,47,0,3"
  110.                       CALL DBTOOLS WITH "19,8"
  111.                    CASE mOPT = 2
  112.                       CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
  113.                       CALL DBTOOLS WITH "1,8,47,0,3,0,This is popup help for"
  114.                       CALL DBTOOLS WITH "1,9,47,0,3,0,Option 2!"
  115.                       CALL DBTOOLS WITH "10,12,47,0,3"
  116.                       CALL DBTOOLS WITH "19,8"
  117.                    CASE mOPT = 3
  118.                       CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
  119.                       CALL DBTOOLS WITH "1,8,47,0,11,0,ABORT! ABORT! ABORT! ABORT!"
  120.                       CALL DBTOOLS WITH "1,9,47,0,3,0,(Quit)"
  121.                       CALL DBTOOLS WITH "10,12,47,0,3"
  122.                       CALL DBTOOLS WITH "19,8"
  123.                 ENDCASE
  124.             OTHERWISE                           && Fkey other than F1
  125.                 mSTUFF="Scancodes are: "+TRIM(STR(mKEY,3))+","+TRIM(STR(mSCAN,3))
  126.                 CALL DBTOOLS WITH "1,15,26,14,5,0,"+mSTUFF
  127.          ENDCASE                                && mSCAN
  128.    ENDCASE                                      && mCHOICE
  129. ENDDO
  130.  
  131. CALL DBTOOLS WITH "14,3,0"
  132. RETURN
  133.