home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / nan_news / vol3 / no5 / twomenu1.prg < prev    next >
Text File  |  1989-03-01  |  4KB  |  185 lines
  1. * Program: TwoMenu1.prg
  2. * Author:  Rick Spence
  3. * Version: Clipper Summer '87
  4. * Note(s): Refer to Function Definition below.
  5. *
  6. * Copyright (c) 1989 Nantucket Corporation.
  7.  
  8. * Sample call for the twodmenu() function.
  9. CLEAR
  10.  
  11. t = 10
  12. l = 10
  13. b = 20
  14. r = 45
  15.  
  16. PRIVATE sel_list[7]
  17.  
  18. sel_list[1] = "Brauer, Doris"
  19. sel_list[2] = "Brown, Laurell"
  20. sel_list[3] = "Cummings-Knight, Philip"
  21. sel_list[4] = "Gruen, Keith"
  22. sel_list[5] = "Humbs, Ingrid"
  23. sel_list[6] = "Muller, Dietmar"
  24. sel_list[7] = "Spence, Rick"
  25.  
  26. PRIVATE commands[4]
  27.  
  28. commands[1] = "Select"
  29. commands[2] = "Delete"
  30. commands[3] = "Insert"
  31. commands[4] = "Exit"
  32.  
  33. com_sel = 3
  34. sel_no = twodmenu(t, l, b, r, sel_list, commands, @com_sel)
  35.  
  36. ? sel_no, com_sel
  37.  
  38.  
  39. * Function Definition:
  40. *
  41. * NUMERIC twodmenu(t, l, b, r, sel_list, commands, @com_selected)
  42. *                       
  43. * NUMERIC t, l, b, r    - The box's coordinates.
  44. *
  45. * CHARACTER sel_list[]  - The list of items from which to choose.
  46. *
  47. * CHARACTER commands[]  - The list of commands.
  48. *
  49. * NUMERIC @com_selected - The number of the selected command.
  50. *                         This must be passed by reference.
  51. *
  52. * The function returns the element number of the sel_list array
  53. * that the user chose.  This is zero if the user escaped from the
  54. * function with the Escape key.
  55. *
  56.  
  57. FUNCTION twodmenu
  58. PARAM t, l, b, r, sel_list, commands, com_selected
  59. PRIVATE selection, win_save, com_cols[len(commands)], i, tot_width
  60. PRIVATE spaces_between, num_commands, cur_pos, start_chars
  61.  
  62. * Initialize required memory variable constants.
  63. init_consts()
  64.  
  65. selection = 1
  66. num_commands = LEN(commands)
  67.  
  68. win_save = SAVESCREEN(t, l, b, r)
  69.  
  70. * Draw interleaved boxes.
  71. @ t, l TO b, r
  72. @ b - 2, l, b, r BOX CHR(195) + CHR(196) + CHR(180) + CHR(179) + ;
  73.    CHR(217) + CHR(196) + CHR(192) + CHR(179)
  74.  
  75. * Figure out spacing for commands.
  76. tot_width = 0
  77. FOR i = 1 TO num_commands
  78.    tot_width = tot_width + LEN(commands[i])
  79. NEXT
  80.  
  81. spaces_between = INT(((r - l - 1) - tot_width)/(num_commands + 1))
  82.  
  83. * Draw commands.
  84. cur_pos = l + 1 + spaces_between
  85. start_chars = ""
  86.  
  87. FOR i = 1 TO num_commands
  88.     com_cols[i] = cur_pos
  89.     @ b - 1, cur_pos SAY commands[i]
  90.     cur_pos = cur_pos + LEN(commands[i]) + spaces_between
  91.     start_chars = start_chars + UPPER(SUBSTR(commands[i], 1, 1))
  92. NEXT
  93.  
  94.  
  95. highlight_current()
  96.  
  97. * Clear the list area.
  98. SCROLL(t + 1, l + 1, b - 3, r - 1, 0)
  99.  
  100. selection = ACHOICE(t + 1, l + 1, b - 3, r - 1, sel_list, ".T.", ;
  101.    "ac_func")
  102. restscreen(t, l, b, r, win_save)
  103.  
  104. RETURN selection
  105.  
  106.  
  107. * ACHOICE() user function.
  108. FUNCTION ac_func
  109. PARAMETER mode, cur_elem, rel_pos
  110. PRIVATE ret_val, lkey
  111.  
  112. ret_val = ac_continue
  113. IF mode = ac_excep
  114.    lkey = LASTKEY()
  115.    DO CASE
  116.       CASE lkey = ESC
  117.          ret_val = ac_abort
  118.  
  119.       CASE lkey = enter .OR. UPPER(CHR(lkey)) $ start_chars
  120.          ret_val = ac_select
  121.          IF lkey != enter
  122.             dehighlight_current()
  123.             com_selected = at(UPPER(CHR(lkey)), start_chars)
  124.             highlight_current()
  125.          ENDIF
  126.  
  127.       CASE lkey = left_arrow
  128.          dehighlight_current()
  129.          IF com_selected = 1
  130.              com_selected = num_commands
  131.          ELSE
  132.              com_selected = com_selected - 1
  133.          ENDIF
  134.  
  135.          highlight_current()
  136.          ret_val = ac_continue
  137.  
  138.       CASE lkey = right_arrow
  139.          dehighlight_current()
  140.          IF com_selected = num_commands
  141.             com_selected = 1
  142.          ELSE
  143.             com_selected = com_selected + 1
  144.          ENDIF
  145.  
  146.          highlight_current()
  147.          ret_val = ac_continue
  148.    ENDCASE
  149. ENDIF
  150. RETURN ret_val
  151.  
  152.  
  153. FUNCTION highlight_current
  154. * Highlight current command.
  155. @ b - 1, com_cols[com_selected] GET commands[com_selected]
  156. CLEAR GETS
  157. RETURN void
  158.  
  159.  
  160. FUNCTION dehighlight_current
  161. * Un-Highlight current command.
  162. @ b - 1, com_cols[com_selected] SAY commands[com_selected]
  163. RETURN void
  164.  
  165.  
  166. FUNCTION init_consts
  167. PUBLIC left_arrow, right_arrow, void, esc, enter
  168. PUBLIC ac_continue, ac_select, ac_abort, ac_excep
  169.  
  170. left_arrow = 19
  171. right_arrow = 4
  172. esc = 27
  173. enter = 13
  174.  
  175. void = .T.
  176.  
  177. ac_abort = 0
  178. ac_select = 1
  179. ac_continue = 2
  180. ac_excep  = 3 
  181.  
  182. RETURN void
  183.  
  184. * EOF: TwoMenu1.prg
  185.