home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / keyboard / hotget / hotmenu.prg < prev   
Text File  |  1992-01-25  |  4KB  |  103 lines
  1. /*
  2.  HOTMENU.PRG
  3.  Enhancement for PROMPT and MENU which allows hot keys to be displayed in
  4.  a different color and to be something other than the first letter.
  5.  
  6.  This program requires the include file HOTMENU.CH, which redefines
  7.  PROMPT and MENU TO.
  8.  
  9.  CHOICES is a 2-dimensional array of menu prompts.  Each element is a
  10.  sub-array containing 4 elements: 1) row, 2) column, 3) prompt text,
  11.  4) position of hot key in text (if hot key is the first letter, this
  12.  can be omitted).
  13. */
  14.  
  15. #include "inkey.ch"
  16.  
  17. STATIC choices:={}
  18.  
  19. * The PROMPT command is redefined to call this function.
  20. FUNCTION MAKE_PRMPT (row,col,text,hpos)
  21.   aadd(choices,{row,col,text,iif(hpos=nil,1,hpos)})
  22. RETURN nil
  23.  
  24. * The MENU TO command is redefined to call this function.
  25. FUNCTION HOT_MENU (curr)
  26. LOCAL l:=len(choices), width:=0, n, k, a, prev, choice, ;
  27.  col_prompt:=setcolor(), old_cursor, col_high, col_hotkey, key_block
  28. /* Parse the SETCOLOR string (if it has only one color, there will be no
  29.    highlight color for the menu bars!).  First chop off the leftmost part
  30.    (standard color) to get the highlight color.  Then see if there are still
  31.    any commas; if so, set the hotkey color to the rightmost portion. */
  32. a:=at(",",col_prompt)
  33. col_high:=substr(col_prompt,a+1)
  34. a:=at(",",col_high)
  35. col_hotkey:=iif(a=0,col_prompt,substr(col_prompt,rat(",",col_prompt)+1))
  36. /* Determine if it is a vertical or horizontal menu by checking if the first
  37.    two choices are in the same row.  If it is vertical, pad the choices to
  38.    the same length; don't pad if horizontal because it looks lousy. */
  39. IF choices[1,1]<>choices[2,1]
  40.   FOR n=1 TO l
  41.     width:=max(width,len(choices[n,3]))
  42.   NEXT
  43.   FOR n=1 TO l
  44.     choices[n,3]:=padr(choices[n,3],width)
  45.   NEXT
  46. ENDIF
  47. FOR n=1 TO l
  48.   @ choices[n,1],choices[n,2] SAY choices[n,3] COLOR col_prompt
  49.   @ choices[n,1],choices[n,2]+choices[n,4]-1 ;
  50.    SAY substr(choices[n,3],choices[n,4],1) COLOR col_hotkey
  51. NEXT
  52. IF curr=nil
  53.   curr:=1
  54. ENDIF
  55. prev:=curr
  56. old_cursor:=setcursor(0)
  57. DO WHILE .T.
  58.   @ choices[prev,1],choices[prev,2] SAY choices[prev,3] COLOR col_prompt
  59.   @ choices[prev,1],choices[prev,2]+choices[prev,4]-1 ;
  60.    SAY substr(choices[prev,3],choices[prev,4],1) COLOR col_hotkey
  61.   @ choices[curr,1],choices[curr,2] SAY choices[curr,3] COLOR col_high
  62.   k:=inkey(0)
  63.   DO CASE
  64.   CASE k=K_ESC
  65.     curr:=0
  66.     EXIT
  67.   CASE k=K_ENTER
  68.     EXIT
  69.   CASE k=K_UP .OR. k=K_LEFT
  70.     prev:=curr
  71.     curr:=iif(curr=1,l,curr-1)
  72.   CASE k=K_DOWN .OR. k=K_RIGHT
  73.     prev:=curr
  74.     curr:=iif(curr=l,1,curr+1)
  75.   CASE k=K_HOME .OR. k=K_PGUP
  76.     prev:=curr
  77.     curr:=1
  78.   CASE k=K_END .OR. k=K_PGDN
  79.     prev:=curr
  80.     curr:=l
  81.   CASE k>=32 .and. k<=127
  82.     a:=ascan(choices,{|c| upper(substr(c[3],c[4],1))=upper(chr(k))})
  83.     IF a>0
  84.       prev:=curr
  85.       curr:=a
  86. /* Even though the menu is being EXITed at this point, highlight the choice
  87.    anyway.  If a submenu is displayed, this avoids the confusion which would
  88.    occur if the first menu appeared to have the wrong choice highlighted. */
  89.       @ choices[prev,1],choices[prev,2] SAY choices[prev,3] COLOR col_prompt
  90.       @ choices[prev,1],choices[prev,2]+choices[prev,4]-1 SAY ;
  91.        substr(choices[prev,3],choices[prev,4],1) COLOR col_hotkey
  92.       @ choices[curr,1],choices[curr,2] SAY choices[curr,3] COLOR col_high
  93.       EXIT
  94.     ENDIF
  95.   CASE (key_block:=setkey(k)) != nil   // support for SET KEY
  96.     eval(key_block,procname(1),procline(),readvar())
  97.   OTHERWISE
  98.   ENDCASE
  99. ENDDO
  100. asize(choices,0)
  101. setcursor(old_cursor)
  102. RETURN curr
  103.