home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSACALL.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  2.8 KB  |  131 lines
  1. <<* MSACALL.INC *>>
  2. <<#
  3.  
  4. function GetPrgName( prompt : string ) : string
  5. string fspec
  6. begin
  7.   input prompt to fspec
  8.   if fspec
  9.     filespec( fspec,fpath,fname,fext )
  10.     fspec := fpath + fname + '.PRG'      <<*Force '.PRG' extension*>>
  11.   end
  12.   RETURN fspec
  13. end <<*GetPrgName*>>
  14.  
  15.  
  16. #>>
  17.  
  18.  
  19. <<function OptionMenu( choice : integer;
  20.                        menuhdg : string;
  21.                        m0,m1,m2,m3,m4,m5,m6,m7 : string ) : integer>>
  22. <<#
  23. integer options
  24. string pic0,pic1,pic2,pic3,pic4,pic5,pic6,pic7
  25.  
  26.  
  27. function iftoggle( bitval : integer ) : string   <<*nested function*>>
  28. begin
  29.   if (options and bitval) <> 0   <<*Is the bit set?*>>
  30.     RETURN ' on '              <<*YES*>>
  31.   else
  32.     RETURN ' ── '              <<*NO*>>
  33.   endif
  34. end iftoggle
  35.  
  36.  
  37. begin <<*OptionMenu*>>
  38.   options := 0
  39.   repeat
  40.     options := options xor (1 shl (choice-1))   <<*Toggle bit value*>>
  41.     pic0 := iftoggle(  1 )
  42.     pic1 := iftoggle(  2 )
  43.     pic2 := iftoggle(  4 )
  44.     pic3 := iftoggle(  8 )
  45.     pic4 := iftoggle( 16 )
  46.     pic5 := iftoggle( 32 )
  47.     pic6 := iftoggle( 64 )
  48.     pic7 := iftoggle( 128 )
  49.     initmenu( menuhdg )
  50.       pic0 + m0 : 'Press RETURN to select or unselect;  ESC finishes'
  51.       pic1 + m1  <<*The above menu message defaults to next options*>>
  52.       pic2 + m2
  53.       pic3 + m3
  54.       pic4 + m4
  55.       pic5 + m5
  56.       pic6 + m6
  57.       pic7 + m7
  58.     end
  59.     menu to choice
  60.   until choice = 0
  61.   RETURN options
  62. end OptionMenu
  63.  
  64.  
  65. function SelectGroup : integer
  66. integer group
  67. begin
  68. #>>
  69.   <<group := OptionMenu( 0,'Program Groups to Generate',
  70.       'All program groups',
  71.       'MENU file',
  72.       'PROCEDURE file',
  73.       'MAIN-OPEN-APPE-EDIT',
  74.       'BROW-DISP-COND-EXPR-PHRA',
  75.       'HELP-LABE-PACK-REPO',
  76.       '<user-defined>',
  77.       '<user-defined>'
  78.     )>>
  79. <<#
  80.   RETURN group
  81. end SelectGroup
  82.  
  83.  
  84. function SubMenuType : integer
  85. integer menutype
  86. begin
  87.     menutype := 3
  88.   RETURN menutype
  89. end SubMenuType
  90.  
  91.  
  92. function MainMenuType : integer
  93. integer menutype
  94. begin
  95.   menutype := 2   <<*default*>>
  96.   RETURN menutype
  97. end MainMenuType
  98.  
  99.  
  100. procedure GenMainMenu( menutype : integer )
  101. string fspec
  102. begin
  103.   fspec := prgpath + fileprefix + '_MBAR.PRG'
  104.   if OpenFile( fspec,'BAR MENU program for ' + datafile + '.DBF' )
  105.       GenLiteBarMenu
  106.     GenFooter( fspec )
  107.   endif
  108. end <<*GenMainMenu*>>
  109.  
  110.  
  111. function SelectFeatures : integer
  112. integer features
  113. begin
  114. #>>
  115.   <<features := OptionMenu( 0,'Program Features to Include',
  116.       'All fields in one Query Table',
  117.       'Label/Report option in Append/Edit',
  118.       "Browse using Tom Rettig's Library",
  119.       '4th feature (none)',
  120.       '5th feature (none)',
  121.       '6rd feature (none)',
  122.       '7th feature (none)',
  123.       '8th feature (none)'
  124.     )>>
  125. <<#
  126.   RETURN features
  127. end SelectFeatures
  128.  
  129. <<* EOF: MSACALL.INC *>>
  130. #>>
  131.