home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / AP1MENU.INC < prev    next >
Encoding:
Text File  |  1988-02-10  |  6.3 KB  |  238 lines
  1. <<* APPMENU.INC *>>
  2. <<#
  3.  
  4. function ExpandName( name : string ) : string
  5. string  strg
  6. integer cp,namelen,count
  7. begin
  8.   cp := 1
  9.   namelen := len( name )
  10.   strg := replicate( ' ',80 )
  11.   for count := 1 to namelen   <<*E-X-P-A-N-D the string*>>
  12.     strg[ cp ] := name[ count ]
  13.     cp := cp + 2
  14.   end
  15.   strg[0] := chr( namelen * 2 - 1 )  <<*Assign the new string length*>>
  16.   RETURN strg
  17. end ExpandName
  18.  
  19.  
  20. procedure GenMenuStatus
  21. string line
  22. integer col
  23. begin
  24.   forall databases
  25.     filespec( dbfnam,fpath,fname,fext )
  26.     line := line + fname + space( 8 - len(fname) )
  27.   endfor
  28. #>>
  29. @  0, 0 SAY {"}{line}{"}
  30. @  0,72 SAY DATE()
  31. DO CASE
  32. <<forall databases>>
  33. CASE dbfarea = {"}{dbfcount}{"}
  34.   <<col := (dbfcount - 1) * 8>>
  35.   <<GenColor( 1,'HILITE' )>>
  36.   <<filespec( dbfnam,fpath,fname,fext )>>
  37.   <<fname := fname + space( 8 - len(fname) )>>
  38.    @ 0,{col} SAY {"}{fname}{"}
  39. <<endfor>>
  40. ENDCASE
  41. <<GenColor( 0,'SCREEN' )>>
  42. <<end GenMenuStatus>>
  43.  
  44.  
  45. <<procedure GenSingleLiteBar>>
  46. <<begin>>
  47. PARAMETER choice
  48. PRIVATE col
  49. <<GenColor( 0,'SCREEN' )>>
  50. CLEAR
  51. * ---Center the menu heading.
  52. <<fname := ExpandName( menutitle )>>
  53. menuhdg = {"}{fname}    M A I N    M E N U{"}
  54. col = (80 - LEN(menuhdg)) / 2
  55. @  1,0 TO 15,79 DOUBLE
  56. @  3, 0 SAY "╠═══════════════════════════════════════"
  57. @  3,40 SAY "═══════════════════════════════════════╣"
  58. @  2,col SAY menuhdg
  59. <<GenColor( 0,'PROMPT' )>>
  60. SET MESSAGE TO 17
  61. menuchoice = AT( choice,"QABEHLPR" )
  62. IF (menuchoice < 1) .OR. (menuchoice > 8)
  63.    menuchoice = 4
  64. ENDIF
  65. col = 33
  66. @  5,col PROMPT " 0. Quit "      MESSAGE "Return to DOS"
  67. @  6,col PROMPT " 1. Append "    MESSAGE "Add New Records"
  68. @  7,col PROMPT " 2. Browse "    MESSAGE "Browse Existing Records"
  69. @  8,col PROMPT " 3. Edit/View " MESSAGE "View, Change, Delete Records"
  70. @  9,col PROMPT " 4. Help "      MESSAGE "See System Structure"
  71. @ 10,col PROMPT " 5. Labels "    MESSAGE "Print Mailing Labels"
  72. @ 11,col PROMPT " 6. Pack "      MESSAGE "Remove Deleted Records"
  73. @ 12,col PROMPT " 7. Report "    MESSAGE "Print Report(s)"
  74. * ---Press <ESC>, <Return>, <PgDn> or the first character "1"..."7".
  75. * ---Assigns 0 (on <ESC>) or 1 thru 7 to menuchoice.
  76. MENU TO menuchoice
  77. choice = SUBSTR( "QQABEHLPR",menuchoice + 1,1 )
  78. * ---Release row 17.
  79. SET MESSAGE TO
  80. * ---Save menu selection.
  81. <<end GenSingleLiteBar>>
  82.  
  83.  
  84. <<procedure GenMultiLiteBar>>
  85. <<begin>>
  86. PARAMETER choice
  87. PRIVATE col
  88. <<GenColor( 0,'SCREEN' )>>
  89. CLEAR
  90. <<GenMenuStatus>>
  91. * ---Center the menu heading.
  92. <<fname := ExpandName( menutitle )>>
  93. menuhdg = {"}{fname}    M A I N    M E N U{"}
  94. col = (80 - LEN(menuhdg)) / 2
  95. @  1,0 TO 16,79 DOUBLE
  96. @  3, 0 SAY "╠═══════════════════════════════════════"
  97. @  3,40 SAY "═══════════════════════════════════════╣"
  98. @  2,col SAY menuhdg
  99. <<GenColor( 0,'PROMPT' )>>
  100. SET MESSAGE TO 18
  101. menuchoice = AT( choice,"QABEHLPRS" )
  102. IF (menuchoice < 1) .OR. (menuchoice > 9)
  103.    menuchoice = 4
  104. ENDIF
  105. col = 33
  106. @  5,col PROMPT " 0. Quit "      MESSAGE "Return to DOS"
  107. @  6,col PROMPT " 1. Append "    MESSAGE "Add New Records"
  108. @  7,col PROMPT " 2. Browse "    MESSAGE "Browse Existing Records"
  109. @  8,col PROMPT " 3. Edit/View " MESSAGE "View, Change, Delete Records"
  110. @  9,col PROMPT " 4. Help "      MESSAGE "See System Structure"
  111. @ 10,col PROMPT " 5. Labels "    MESSAGE "Print Mailing Labels"
  112. @ 11,col PROMPT " 6. Pack "      MESSAGE "Remove Deleted Records"
  113. @ 12,col PROMPT " 7. Report "    MESSAGE "Print Report(s)"
  114. @ 13,col PROMPT " 8. Select "    MESSAGE "Select Database File"
  115. * ---Press <ESC>, <Return>, <PgDn> or the first character "1"..."8".
  116. * ---Assigns 0 (on <ESC>) or 1 thru 8 to menuchoice.
  117. MENU TO menuchoice
  118. choice = SUBSTR( "QQABEHLPRS",menuchoice + 1,1 )
  119. * ---Release row 18.
  120. SET MESSAGE TO
  121. * ---Save menu selection.
  122. <<end GenMultiLiteBar>>
  123.  
  124.  
  125. <<#
  126. procedure GenLiteBarMenu
  127. begin
  128.   if ismultials
  129.     GenMultiLiteBar
  130.   else
  131.     GenSingleLiteBar
  132.   endif
  133. end GenLiteBarMenu
  134. #>>
  135.  
  136.  
  137. <<procedure GenMultiSimple>>
  138. <<integer row>>
  139. <<string  line>>
  140. <<begin>>
  141. PARAMETER choice
  142. PRIVATE col
  143. <<GenColor( 0,'SCREEN' )>>
  144. CLEAR
  145. <<GenMenuStatus>>
  146. * ---Center the menu heading.
  147. <<fname := ExpandName( menutitle )>>
  148. menuhdg = {"}{fname}    M A I N    M E N U{"}
  149. col = (80 - LEN(menuhdg)) / 2
  150. @  1,0 TO 16,79 DOUBLE
  151. @  3, 0 SAY "╠═══════════════════════════════════════"
  152. @  3,40 SAY "═══════════════════════════════════════╣"
  153. @  2,col SAY menuhdg
  154. <<GenColor( 0,'PROMPT' )>>
  155. col = 34
  156. @  5,col SAY "0. Quit"
  157. @  6,col SAY "1. Append"
  158. @  7,col SAY "2. Browse"
  159. @  8,col SAY "3. Edit/View"
  160. @  9,col SAY "4. Help"
  161. @ 10,col SAY "5. Labels"
  162. @ 11,col SAY "6. Pack"
  163. @ 12,col SAY "7. Report"
  164. @ 13,col SAY "8. Select "
  165. @ 16,33 SAY " select : : "
  166. @ 16,42 SAY ""
  167. * ---Allow either the number or the first letter of a menu item.
  168. SET INTENSITY OFF
  169. choice = "*"
  170. DO WHILE .NOT. (choice $ "012345678QABEHLPRS")
  171.    choice = " "
  172.    @ 16,42 GET choice PICTURE "!"
  173.    READ
  174. ENDDO
  175. SET INTENSITY ON
  176. * ---Number becomes first letter of menu selection.
  177. IF choice $ "012345678"
  178.    choice = SUBSTR( "QABEHLPRS",VAL( choice ) + 1,1 )
  179. ENDIF
  180. <<end GenMultiSimple>>
  181.  
  182.  
  183. <<procedure GenSingleSimple>>
  184. <<integer row>>
  185. <<begin>>
  186. PARAMETER choice
  187. PRIVATE col
  188. <<GenColor( 0,'SCREEN' )>>
  189. CLEAR
  190. * ---Center the menu heading.
  191. <<fname := ExpandName( menutitle )>>
  192. menuhdg = {"}{fname}    M A I N    M E N U{"}
  193. col = (80 - LEN(menuhdg)) / 2
  194. @  1,0 TO 15,79 DOUBLE
  195. @  3, 0 SAY "╠═══════════════════════════════════════"
  196. @  3,40 SAY "═══════════════════════════════════════╣"
  197. @  2,col SAY menuhdg
  198. <<GenColor( 0,'PROMPT' )>>
  199. col = 34
  200. @  5,col SAY "0. Quit"
  201. @  6,col SAY "1. Append"
  202. @  7,col SAY "2. Browse"
  203. @  8,col SAY "3. Edit/View"
  204. @  9,col SAY "4. Help"
  205. @ 10,col SAY "5. Labels"
  206. @ 11,col SAY "6. Pack"
  207. @ 12,col SAY "7. Report"
  208. @ 15,33 SAY " select : : "
  209. @ 15,42 SAY ""
  210. * ---Allow either the number or the first letter of a menu item.
  211. SET INTENSITY OFF
  212. choice = "*"
  213. DO WHILE .NOT. (choice $ "01234567QABEHLPR")
  214.    choice = " "
  215.    @ 15,42 GET choice PICTURE "!"
  216.    READ
  217. ENDDO
  218. SET INTENSITY ON
  219. * ---Number becomes first letter of menu selection.
  220. IF choice $ "01234567"
  221.    choice = SUBSTR( "QABEHLPR",VAL( choice ) + 1,1 )
  222. ENDIF
  223. <<end GenSingleSimple>>
  224.  
  225.  
  226. <<#
  227. procedure GenSimpleMenu
  228. begin
  229.   if ismultials
  230.     GenMultiSimple
  231.   else
  232.     GenSingleSimple
  233.   endif
  234. end GenSimpleMenu
  235.  
  236. <<* EOF: APPMENU.INC *>>
  237. #>>
  238.