home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / MENUH.PRG < prev    next >
Encoding:
Text File  |  1991-04-23  |  1.8 KB  |  63 lines

  1. /*
  2.      Program: MENUH()
  3.      System: GRUMPFISH LIBRARY
  4.      Author: Greg Lief
  5.      Copyright (c) 1988-90, Greg Lief
  6.      Clipper 5.x version
  7.      Compile instructions: clipper menuh /n/w/a
  8.      Creates horizontal bounce-bar menu
  9. */
  10.  
  11. //───── begin preprocessor directives
  12.  
  13. #include "grump.ch"
  14.  
  15. //───── end preprocessor directives
  16.  
  17. //───── begin global declarations
  18.  
  19. #define NextItem(msg) substr(msg, 1, at("$", msg) - 1)
  20. #define Truncate(msg) substr(msg, at("$", msg) + 1, len(msg) - at("$", msg))
  21.  
  22. //───── end global declarations
  23.  
  24. function menuh(nrow, ncol, spacing, prompts, messages, mcolor)
  25. local prom, msg, choice := 1, ptr1 := 1, ptr2 := 1, oldcolor, ;
  26.       oldmessc, oldmessrow, oldwrap
  27. GFSaveEnv()
  28. oldmessc := set(_SET_MCENTER, .T.)  // set message to be centered
  29. //───── if no message row has been established already, set it to 24
  30. if (oldmessrow := set(_SET_MESSAGE)) == 0
  31.    set(_SET_MESSAGE, 24)
  32. endif
  33. oldwrap := set(_SET_WRAP, .T.)     // SET WRAP ON
  34.  
  35. default messages to ''
  36. default mcolor to ColorSet(C_MENU_UNSELECTED, .T.) + ',' + ;
  37.                   ColorSet(C_MENU_SELECTED, .T.)
  38. setcolor(mcolor)
  39. if '$' $ prompts
  40.    prompts := trim(prompts)
  41.    prompts := prompts + ;
  42.                 if(substr(prompts, len(prompts), 1) = '$', '', '$')
  43.    do while ptr1 < len(prompts)
  44.       prom := NextItem(prompts)
  45.       @ nrow, ncol prompt prom message NextItem(messages)
  46.       prompts := Truncate(prompts)
  47.       messages := Truncate(messages)
  48.       ncol += len(prom) + spacing
  49.    enddo
  50.    menu to choice
  51. endif
  52. //───── restore previous message and wrap settings
  53. set(_SET_MCENTER, oldmessc)
  54. set(_SET_MESSAGE, oldmessrow)
  55. set(_SET_WRAP, oldwrap)
  56. GFRestEnv()
  57. return(choice)
  58.  
  59. * end function MenuH()
  60. *--------------------------------------------------------------------*
  61.  
  62. * eof menuh.prg
  63.