home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / lbargen.zip / LBARGEN.PAS < prev   
Pascal/Delphi Source File  |  1986-11-05  |  7KB  |  251 lines
  1. const
  2.   start_char = 64;
  3.   spaces     = '                                        ';
  4.  
  5. var
  6.   x,y          : integer;
  7.   menu_items   : array[1..20] of string[40];
  8.   menu_choices : array[1..20] of string[ 8];
  9.   outfile      : text;
  10.   filename     : string[8];
  11.   menu_title   : string[40];
  12.   proc_title   : string[8];
  13.   need_proc    : boolean;
  14.   ch           : char;
  15.  
  16. procedure get_file_name;
  17. begin
  18.   ClrScr;
  19.   gotoXY(10,10); write('Enter file name [no extent] :'); read(filename);
  20.   assign(outfile,filename+'.PRG');
  21.   rewrite(outfile);
  22.   ClrScr;
  23.   gotoXY(10,10); write('Enter the title for this menu');
  24.   gotoXY(6,12); write('[________________________________________]');
  25.   gotoXY(7,12); read(menu_title);
  26.   if length(menu_title) < 40 then
  27.     menu_title:=copy(spaces,1,(40-length(menu_title)) div 2) + menu_title +
  28.     copy(spaces,1,(40-length(menu_title)) div 2);
  29.   if length(menu_title) < 40 then
  30.     menu_title:=menu_title+' ';
  31.   if length(menu_title) < 40 then
  32.     menu_title:=' '+menu_title;
  33.   ClrScr;
  34.   gotoXY(10, 8);
  35.   write('Is there a procedure file asscoiated with this menu: ');
  36.   read(kbd,ch);
  37.   if ch in ['y','Y'] then need_proc:=true else need_proc := false;
  38.   if need_proc then
  39.   begin
  40.     gotoXY(10,10);
  41.     write('Enter file name [no extent] :'); read(proc_title);
  42.   end;
  43. end;
  44.  
  45. procedure get_munu_items;
  46. begin
  47.   ClrScr;
  48.   gotoXY(10,1); write('How many menu items for this menu: '); read(x);
  49.   for y := 1 to x do
  50.   begin
  51.     gotoXY(5,2+y); write('[________________________________________]');
  52.   end;
  53.   for y:= 1 to x do
  54.   begin
  55.     gotoXY(6,2+y); read(menu_items[y]);
  56.     menu_items[y]:=copy(menu_items[y],1,length(menu_items[y]))+
  57.                    copy(spaces,1,40-length(menu_items[y]));
  58.   end;
  59. end;
  60.  
  61.  
  62. procedure show_menu_items;
  63. begin
  64.   ClrScr;
  65.   for y := 1 to x do
  66.   begin
  67.     gotoXY(5,y+2); write('[',chr(start_char+y),'] ',menu_items[y]);
  68.   end;
  69. end;
  70.  
  71. procedure get_choices;
  72.  
  73. begin
  74.   gotoXY(5,1); write('Enter command file to call for each menu choice: ');
  75.   for y:= 1 to x do
  76.   begin
  77.     gotoXY(50,y+2); write('[________]');
  78.   end;
  79.   for y:=1 to x do
  80.   begin
  81.     gotoXY(51,y+2); read(menu_choices[y]);
  82.   end;
  83. end;
  84.  
  85. procedure write_outfile;
  86.  
  87. var
  88.   z,
  89.   add_line,
  90.   box_size,
  91.   box_start : integer;
  92.  
  93. begin
  94.   writeln(outfile,'SET TALK OFF');
  95.   writeln(outfile,'SET STATUS OFF');
  96.   writeln(outfile,'SET SCOREBOARD OFF');
  97.   if need_proc then
  98.   writeln(outfile,'SET PROCEDURE TO ',proc_title);
  99.   writeln(outfile,'STORE .T. TO more');
  100.   writeln(outfile,'DO WHILE more');
  101.   writeln(outfile,'  RELEASE ALL');
  102.   writeln(outfile,'  CLOSE DATABASES');
  103.   writeln(outfile,'  CLOSE INDEX');
  104.   writeln(outfile,'  SET BELL OFF');
  105.   writeln(outfile,'  SET DEVICE TO SCREEN');
  106.   writeln(outfile,'  SET PRINT OFF');
  107.   writeln(outfile,'  SET TALK OFF');
  108.   writeln(outfile,'  x=',x:2);
  109.   for y := 1 to x do
  110.   begin
  111.     write(outfile,'  title');
  112.     if y < 10 then
  113.       write(outfile,y:1)
  114.     else
  115.       write(outfile,y:2);
  116.     writeln(outfile,' = "','[',chr(start_char+y),'] ',menu_items[y],'"');
  117.   end;
  118.   write(outfile,'  title');
  119.     if y < 10 then
  120.       write(outfile,y+1:1)
  121.     else
  122.       write(outfile,y+1:2);
  123.     writeln(outfile,' = "[X] Exit                                    "');
  124.   writeln(outfile,'  ChoiceNum = ',x+1:2);
  125.   writeln(outfile,'  CLEAR');
  126.   writeln(outfile,'  CHOICE=1');
  127.   writeln(outfile,'  menutitle = "     ',menu_title,'      "');
  128.   if x > 9 then add_line :=1 else add_line := 2;
  129.   writeln(outfile,'  SET COLOR TO n/w');
  130.   box_size := x*add_line+2;
  131.   box_start:= (24 - box_size) div 2;
  132.   writeln(outfile,'  @ ',box_start-1:2,',15 SAY menutitle');
  133.   writeln(outfile,'  SET COLOR TO w/n');
  134.   writeln(outfile,'  @ ',box_start:2,',15 TO ',
  135.                   box_start+box_size:2,',65 DOUBLE');
  136.  
  137.   y := box_start+1;
  138.   z:=1;
  139.   repeat
  140.     if z=1 then writeln(outfile,'  SET COLOR TO n/w');
  141.     write(outfile,'  @ ',y:2,',19 say Title');
  142.     if z < 10 then
  143.       writeln(outfile,z:1)
  144.     else
  145.       writeln(outfile,z:2);
  146.     if z=1 then writeln(outfile,'  SET COLOR TO w/n');
  147.     y:=y+add_line;
  148.     z:=z+1;
  149.   until z > x;
  150.   write(outfile,'  @ ',y:2,',19 say Title');
  151.   if z < 10 then
  152.     writeln(outfile,z:1)
  153.   else
  154.     writeln(outfile,z:2);
  155.   writeln(outfile,'  MenuLoop=.T.');
  156.   writeln(outfile,'  Upkey = 5');
  157.   writeln(outfile,'  DownKey = 24');
  158.   writeln(outfile,'  ReturnKey = 13');
  159.   writeln(outfile,'  key = 0');
  160.   writeln(outfile,'  DO WHILE MenuLoop');
  161.   writeln(outfile,'    PChoice = Choice');
  162.   writeln(outfile,'    DO WHILE key = 0');
  163.   writeln(outfile,'      key=INKEY()');
  164.   writeln(outfile,'    ENDDO');
  165.   writeln(outfile,'    DO CASE');
  166.   writeln(outfile,'      CASE key=88.OR. key = 120');
  167.   writeln(outfile,'        RETURN');
  168.   writeln(outfile,'      CASE key=ReturnKey');
  169.   writeln(outfile,'        MenuLoop=.F.');
  170.   writeln(outfile,'        LOOP');
  171.   writeln(outfile,'      CASE key > 96 .AND. key < ChoiceNum+97');
  172.   writeln(outfile,'        Choice = key - 96');
  173.   writeln(outfile,'        MenuLoop = .F.');
  174.   writeln(outfile,'        LOOP');
  175.   writeln(outfile,'      CASE key > 64 .AND. key < ChoiceNum+65');
  176.   writeln(outfile,'        Choice = key - 64');
  177.   writeln(outfile,'        MenuLoop = .F.');
  178.   writeln(outfile,'        LOOP');
  179.   writeln(outfile,'      CASE key=UpKey .and. Choice > 1');
  180.   writeln(outfile,'        Choice = Choice - 1');
  181.   writeln(outfile,'      CASE key=DownKey .and. Choice < ChoiceNum');
  182.   writeln(outfile,'        Choice = Choice + 1');
  183.   writeln(outfile,'    ENDCASE');
  184.   writeln(outfile,'    SET COLOR TO  w/n');
  185.   writeln(outfile,'    DO CASE');
  186.   y := box_start+1;
  187.   z:=1;
  188.   repeat
  189.     writeln(outfile,'      CASE PChoice =',z:2);
  190.     write(outfile,'        @ ',y:2,',19 say Title');
  191.     if z < 10 then
  192.       writeln(outfile,z:1)
  193.     else
  194.       writeln(outfile,z:2);
  195.     y:=y+add_line;
  196.     z:=z+1;
  197.   until z > x;
  198.   writeln(outfile,'      CASE PChoice =',z:2);
  199.   write(outfile,'        @ ',y:2,',19 say Title');
  200.   if z < 10 then
  201.     writeln(outfile,z:1)
  202.   else
  203.     writeln(outfile,z:2);
  204.   writeln(outfile,'    ENDCASE');
  205.   writeln(outfile,'    SET COLOR TO n/w');
  206.   writeln(outfile,'    DO CASE');
  207.   y := box_start+1;
  208.   z:=1;
  209.   repeat
  210.     writeln(outfile,'      CASE Choice =',z:2);
  211.     write(outfile,'      @ ',y:2,',19 say Title');
  212.     if z < 10 then
  213.       writeln(outfile,z:1)
  214.     else
  215.       writeln(outfile,z:2);
  216.     y:=y+add_line;
  217.     z:=z+1;
  218.   until z > x;
  219.   writeln(outfile,'      CASE Choice =',z:2);
  220.   write(outfile,'      @ ',y:2,',19 say Title');
  221.   if z < 10 then
  222.     writeln(outfile,z:1)
  223.   else
  224.     writeln(outfile,z:2);
  225.   writeln(outfile,'    ENDCASE');
  226.   writeln(outfile,'    SET COLOR TO w/n');
  227.   writeln(outfile,'    key=0');
  228.   writeln(outfile,'  ENDDO');
  229.   writeln(outfile,'  DO CASE ');
  230.   for y:= 1 to x do
  231.   begin
  232.     writeln(outfile,'    CASE Choice =',y:2);
  233.     writeln(outfile,'      DO ',menu_choices[y]);
  234.   end;
  235.     writeln(outfile,'    CASE Choice = ChoiceNum');
  236.     writeln(outfile,'      RETURN');
  237.   writeln(outfile,'  ENDCASE');
  238.   writeln(outfile,'ENDDO');
  239.   writeln(outfile,'RETURN');
  240.   close(outfile);
  241. end;
  242.  
  243. begin
  244.   get_file_name;
  245.   get_munu_items;
  246.   show_menu_items;
  247.   get_choices;
  248.   write_outfile;
  249.  
  250. end.
  251.