home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9107.ZIP / PARADOX2 < prev    next >
Encoding:
Text File  |  1991-05-28  |  4.5 KB  |  141 lines
  1. LISTING 2.  A Vertical Menu Proc
  2.  
  3. 1    ; ------------------------------------------------------------
  4. 2    ; Display popup menu and allow scrolling
  5. 3    ; DBMS - Speaking of PAL - July, 1991 - Listing 2
  6. 4    ;
  7. 5    ; This procedure displays a vertical bounce-bar menu and allows
  8. 6    ; the user to scroll through the list to select a menu choice.
  9. 7    ; --------------------------------------------------------------
  10. 8    proc VERTICAL_MENU( TOP.ROW,       ; row of top left corner
  11. 9                        TOP.COL,       ; column of top left corner
  12. 1                        MAX.SIZE,      ; max width of the longest choice
  13. 11                       MENU.COLOR,    ; color for menu and choices
  14. 12                       HIGH.COLOR     ; color for highlight
  15. 13                     )
  16. 14 
  17. 15      private HOW.MANY,
  18. 16              X
  19. 17 
  20. 18      ; determine the size of the array and set the "current" element
  21. 19 
  22. 20      HOW.MANY = arraysize(CHOICES)
  23. 21      WHICH.CHOICE = 1
  24. 22      cursor off
  25. 23 
  26. 24      ; display the drop shadow on the canvas
  27. 25 
  28. 26      paintcanvas
  29. 27         attribute 7
  30. 28         TOP.ROW+1, TOP.COL+2, TOP.ROW+HOW.MANY+2, TOP.COL+MAX.SIZE+5
  31. 29
  32. 30      ; display the menu box itself
  33. 31
  34. 32      paintcanvas
  35. 33         fill " "
  36. 34         attribute MENU.COLOR
  37. 35         TOP.ROW, TOP.COL, TOP.ROW+HOW.MANY+1, TOP.COL+MAX.SIZE+3
  38. 36 
  39. 37      ; display the menu border
  40. 38 
  41. 39      paintcanvas
  42. 40         border
  43. 41         fill "(chr218)" + fill("(chr196)",MAX.SIZE+2) + "(chr191)"
  44. 42                  + fill("(chr179)",HOW.MANY*2) +
  45. 43              "(chr192)" + fill("(chr196)",MAX.SIZE+2) + "(chr217)"
  46. 44         attribute MENU.COLOR
  47. 45         TOP.ROW, TOP.COL, TOP.ROW+HOW.MANY+1, TOP.COL+MAX.SIZE+3
  48. 46 
  49. 47      ; set the color for subsequent writes to the screen
  50. 48
  51. 49      style attribute MENU.COLOR
  52. 50 
  53. 51      ; display prompt on top two lines of the screen
  54. 52 
  55. 53      @ 0,0 clear eol ?? "Highlight choice & press [Enter] to select it"
  56. 54      @ 1,0 clear eol ?? "Or press [Esc] to return to previous screen"
  57. 55 
  58. 56      ; display the menu choices themselves
  59. 57 
  60. 58      for X from 1 to HOW.MANY
  61. 59         @ TOP.ROW+X, TOP.COL+2 ?? CHOICES[X]
  62. 60      endfor
  63. 61
  64. 62      ; keystroke processing loop
  65. 63 
  66. 64      while (true)
  67. 65 
  68. 66         ; highlight the current choice and wait for a keypress
  69. 67         ; then change the color back to the "background"
  70. 68 
  71. 69         paintcanvas
  72. 70            attribute HIGH.COLOR
  73. 71            TOP.ROW+WHICH.CHOICE, TOP.COL+2,
  74. 72            TOP.ROW+WHICH.CHOICE, TOP.COL+MAX.SIZE+1
  75. 73 
  76. 74         retval = getchar()
  77. 75 
  78. 76         paintcanvas
  79. 77            attribute MENU.COLOR
  80. 78            TOP.ROW+WHICH.CHOICE, TOP.COL+2,
  81. 79            TOP.ROW+WHICH.CHOICE, TOP.COL+MAX.SIZE+1
  82. 80 
  83. 81         ; process keystrokes, changing the "current" element
  84. 82 
  85. 83         switch
  86. 84            case retval = -72 :                 ; UP
  87. 85               if WHICH.CHOICE = 1 then
  88. 86                  WHICH.CHOICE = HOW.MANY
  89. 87               else
  90. 88                  WHICH.CHOICE = WHICH.CHOICE - 1
  91. 89               endif
  92. 90 
  93. 91            case retval = -80 :                 ; DOWN
  94. 92               if WHICH.CHOICE = HOW.MANY then
  95. 93                  WHICH.CHOICE = 1
  96. 94               else
  97. 95                  WHICH.CHOICE = WHICH.CHOICE + 1
  98. 96               endif
  99. 97 
  100. 98            case retval = -71 :                 ; HOME
  101. 99               WHICH.CHOICE = 1
  102. 100
  103. 101           case retval = -79 :                 ; END
  104. 102              WHICH.CHOICE = HOW.MANY
  105. 103
  106. 104           case retval = 27 :                  ; ESC
  107. 105              return False
  108. 106
  109. 107           case retval = 13 :                  ; ENTER
  110. 108              return WHICH.CHOICE
  111. 109
  112. 110           otherwise :
  113. 111              beep
  114. 112
  115. 113        endswitch
  116. 114
  117. 115     endwhile
  118. 116
  119. 117  endproc
  120. 118
  121. 119  ; ----------------------------------------------------------
  122. 120  ; sample code to demonstrate the menu in action
  123. 121  ; ----------------------------------------------------------
  124. 122
  125. 123  array CHOICES[6]
  126. 124  CHOICES[1] = "Enter Customers"
  127. 125  CHOICES[2] = "Update Order Volumes"
  128. 126  CHOICES[3] = "Process Outstanding Invoices"
  129. 127  CHOICES[4] = "Generate Summary Reports"
  130. 128  CHOICES[5] = "Archive Old Customers"
  131. 129  CHOICES[6] = "Graph Customer Credit"
  132. 130
  133. 131  VERTICAL_MENU( 2, 10, 28, 31, 79 )
  134. 132
  135. 133  if retval = False then
  136. 134     message "You pressed [Esc]"
  137. 135  else
  138. 136     message "You selected choice ", retval
  139. 137  endif
  140. 138  sleep 1000
  141.