home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / VBMS.ZIP / VMSCHM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-02-18  |  14.9 KB  |  673 lines
  1. PROGRAM VMSCHM;
  2.  
  3. USES
  4.   Crt, Basic;
  5.  
  6. TYPE
  7.   Menustr                          = array[0..8] of string;
  8.  
  9. VAR
  10.   Datastr                          : menustr;
  11.   wd_colm, wd_row, wd_lgth, wd_hgth: integer;
  12.   cl, rw                           : integer;
  13.   i, j, p                          : integer;
  14.   index                            : integer;
  15.   xstr, ystr                       : string;
  16.   tstr                             : char;
  17.   t                                : integer;
  18.   space                            : integer;
  19.   design                           : char;
  20.  
  21. (*
  22.    ==========================================================================
  23.    Shows how to divide and design screen and puts the messages.  This is a
  24.    simple combination of procedures box, border and draw.
  25.    ==========================================================================
  26. *)
  27.  
  28. PROCEDURE Info;
  29.   begin
  30.     screensetup;
  31.     set_color(1,0);
  32.     box(1,1,80,25, false, false);
  33.     set_color(1,1);
  34.     draw(2,1,39,22, #219);
  35.     set_color(1,0);
  36.     draw(2,1,19,22, #219);
  37.  
  38.     border(4,3,80,20,false);
  39.     set_color(0,1);
  40.     draw(45,4,14,1, #220);
  41.     draw(43,4,1,16, #219);
  42.     draw(72,4,1,16, #219);
  43.     set_color(1,0);
  44.     draw(45,19,14,1, #220);
  45.     set_color(1,0);
  46.     border(43, 5, 115, 16, false);
  47.     gotoxy(45,5);
  48.     xstr:='Vertical Bar Menu Schemata';
  49.     set_color(1,0);
  50.     write(centerstr(xstr, 26));
  51.     xstr:='(c) 1993| Ali Kocaturk' ;
  52.     gotoxy(45,6);
  53.     write(#254);
  54.     draw(46,5,13,1, #205);
  55.     gotoxy(71,6);
  56.     write(#254);
  57.     gotoxy(48, 6);
  58.     write(xstr);
  59.     gotoxy(48,8);
  60.     write(' Fax: (201) 223 0578 ');
  61.     set_color(7,1);
  62.     gotoxy(45,9);
  63.     writeln('VBMS v1.00 is Shareware. If');
  64.     gotoxy(45,10);
  65.     writeln('you have any questions and/');
  66.     gotoxy(45,11);
  67.     writeln('or comments, please contact');
  68.     gotoxy(45,12);
  69.     writeln('me. Try it out! If you feel');
  70.     gotoxy(45,13);
  71.     writeln('it is use of to you, please');
  72.     gotoxy(45,14);
  73.     writeln('register now by sending $15');
  74.     gotoxy(45,15);
  75.     writeln('--or whatever is fair-- to:');
  76.     gotoxy(45,16);
  77.     set_color(1,1);
  78.     write(spacestr(27));
  79.     set_color(7,1);
  80.     gotoxy(45,17);
  81.     writeln('Ali Kocaturk               ');
  82.     gotoxy(45,18);
  83.     writeln('409 Harmon Cove Towers     ');
  84.     gotoxy(45,19);
  85.     writeln('Secaucus, New Jersey, 07094');
  86.     movecursor;
  87.  
  88.     set_color(0,1);
  89.     draw(78,1,1,22, #176);
  90.     draw(2,1,1,22,  #176);
  91.     draw(2,1,39,1,  #176);
  92.     draw(2,22,39,1, #176);
  93.  
  94.     set_color(122,117);
  95.     draw(6,3,16,7,  #196);
  96.  
  97.     draw(6,4,1,5,  #219);
  98.     draw(8,9,2,1,  #223);
  99.     draw(12,4,1,5, #219);
  100.     draw(15,4,1,5, #219);
  101.     draw(17,4,2,1, #223);
  102.     draw(19,4,1,2, #219);
  103.     draw(17,6,2,1, #223);
  104.     draw(19,6,1,3, #219);
  105.     draw(15,9,3,1, #223);
  106.     draw(22,4,1,5, #219);
  107.     draw(25,5,1,2, #219);
  108.     draw(28,4,1,5, #219);
  109.     draw(31,4,4,1, #223);
  110.     draw(31,4,1,2, #219);
  111.     draw(31,6,4,1, #223);
  112.     draw(37,6,1,3, #219);
  113.     draw(31,9,4,1, #223);
  114.     set_color(1,7);
  115.     border(6,13,43,8, false);
  116.     gotoxy(6,11);
  117.     set_color(7,1);
  118.     write(spacestr(33));
  119.     set_color(0,1);
  120.     gotoxy(6,12);
  121.     write(spacestr(33));
  122.  
  123.     set_color(0,0);
  124.     draw(7,13,15,6, #178);
  125.     gotoxy(8,14);
  126.     set_color(7,1);
  127.     write( #22,' Creates a menu driven      ');
  128.     gotoxy(8,15);
  129.     write('      programs.               ');
  130.     gotoxy(8,16);
  131.     write( #22,' Provides powers to design  ');
  132.     gotoxy(8 ,17);
  133.     write('      screens.                ');
  134.     gotoxy(8,18);
  135.     write( #22,' Contributes to programming ');
  136.     gotoxy(8 ,19);
  137.     write('      skills.                 ');
  138.     gotoxy(6,21);
  139.     set_color(0,1);
  140.     write(spacestr(33));
  141.     movecursor;
  142.   end;
  143.  
  144. (*
  145.     =========================================================================
  146.     Draws box and/or boxes  at specified coordinates. The line parameter, if
  147.     is set to true, prints horizantal bars two rows from the top of the box
  148.     and two rows up from the bottom. If line parameter is set to false, the
  149.     box will draw a plainbox.  The parameter shadow can be used with or with-
  150.     out the line parameter.
  151.    ==========================================================================
  152. *)
  153.  
  154. PROCEDURE boxdemo;
  155.    begin
  156.      set_color(0,1);
  157.      clrscr;
  158.      set_color(0,1);
  159.      delay(300);
  160.      box(1,1,80,5, false,false);
  161.      draw(2,1,39,2,#186);
  162.      delay(300);
  163.      set_color(1,7);
  164.      box(1,6,80,11, false, false);
  165.      draw(2,6,39,3, #22);
  166.      delay(300);
  167.      set_color(0,1);
  168.      box(1,9,80,25, false, false);
  169.      draw(2,9,39,15, #196);
  170.      restore_screen;
  171.  
  172.      delay(600);
  173.      set_color(7,1);
  174.      box(1,1,80,13,false,false);
  175.      delay(600);
  176.      set_color(0,1);
  177.      box(1,8,80,5,false,false);
  178.      delay(600);
  179.      set_color(7,1);
  180.      box(1,5,80,5,false,false);
  181.      delay(600);
  182.      set_color(7,1);
  183.      box(1,5,80,25, false,false);
  184.      delay(600);
  185.      set_color(7,1);
  186.      box(1,10,80,10, false,false);
  187.      delay(600);
  188.      set_color(7,1);
  189.      box(1,18,80,7,false,false);
  190.      gotoxy(2,8);
  191.      set_color(0,0);
  192.      draw(2,1,39,2, #0);
  193.      draw(2,6,39,2, #0);
  194.      set_color(0,1);
  195.      draw(2,1,39,1,#0);
  196.      draw(2,10,39,1,#177);
  197.      draw(2,18,39,5,#176);
  198.      set_color(7,1);
  199.      delay(500);
  200.  
  201.      border(17,2,56,22,false);
  202.      border(41,2,104,22,false);
  203.      set_color(0,1);
  204.      delay(900);
  205.      draw(18,2,11,20,#255);
  206.      set_color(0,0);
  207.      delay(1200);
  208.      draw(42,2,11,20,#255);
  209.      set_color(1,7);
  210.      delay(900);
  211.      draw(26,5,2,7, #219);
  212.      draw(49,5,4,1,#223);
  213.      draw(53,5,3,4,#219);
  214.      draw(49,9,5,1,#223);
  215.      draw(49,9,2,3,#219);
  216.      delay(300);
  217.      draw(26,13,2,1, #219);
  218.      draw(49,13,2,1,#219);
  219.      restore_screen;
  220.   end;
  221.  
  222.  
  223. (*
  224.    ==========================================================================
  225.    Prints the background character to all locations on the screen; draws
  226.    boxes and saves the content.
  227.    ==========================================================================
  228. *)
  229.  
  230. PROCEDURE Setup;
  231.   begin
  232.     set_color(1,15);
  233.     screensetup;
  234.     set_color(7,1);
  235.     box(1,1,80,25, false, true);
  236.     gotoxy(2,2);
  237.     write(spacestr(78));
  238.     save_screen;
  239.   end;
  240.  
  241.  
  242. (*
  243.   ==========================================================================
  244.   Prints the program's id on the top line; provides information regarding
  245.   help on the bottom line.  The bottom line is where the information are
  246.   to be displayed for the selections.
  247.   ==========================================================================
  248. *)
  249.  
  250. PROCEDURE suppl;
  251.   begin
  252.     gotoxy(2,2);
  253.     xstr:='Procedure call: ';
  254.     write(centerstr(xstr, 78));
  255.     set_color(0,1);
  256.     draw(2,3,39,18, #196);
  257.     set_color(1,0);
  258.     gotoxy(6,9);
  259.     xstr:=('**********************************');
  260.     write(xstr);
  261.     gotoxy(2,23);
  262.     set_color(7,1);
  263.     xstr:='Use <Enter> to return to menu';
  264.     write(centerstr(xstr, 78));
  265.   end;
  266.  
  267.  
  268. PROCEDURE Status;
  269.   begin
  270.     xstr:= 'VMSCHM: Vertical Menu Schemata, v 1.oo, (c) 1993  Ali Kocaturk';
  271.     set_color(15,1);
  272.     gotoxy(2,2);
  273.     write(centerstr(xstr, 78));
  274.  
  275.     xstr:='Use initials or <' + #24 + '><' + #25  +
  276.            '> to select and <Enter> to execute or <Quit> to exit';
  277.     set_color(7,1);
  278.     gotoxy(2,23);
  279.     write(centerstr(xstr, 78));
  280.     set_color(7,4);
  281.     border(5,7,24,10, true);
  282.   end;
  283.  
  284.  
  285. PROCEDURE Main; forward;
  286. PROCEDURE Help; forward;
  287.  
  288. (*
  289.   ===========================================================================
  290.   All applications must be declared before menu.
  291.   ===========================================================================
  292. *)
  293.  
  294. PROCEDURE Aaaaaaa;
  295.  
  296.   begin
  297.     setup;
  298.     suppl;
  299.     gotoxy(9,9);
  300.     xstr:=' Aaaaaaa ';
  301.     write(xstr);
  302.     movecursor;
  303.     readln;
  304.     info;
  305.     readln;
  306.     main;
  307.  
  308.   end;
  309.  
  310.  
  311. PROCEDURE Bbbbbbb;
  312.   begin
  313.     setup;
  314.     suppl;
  315.     gotoxy(9,9);
  316.     write(' Bbbbbbb');
  317.     movecursor;
  318.     readln;
  319.     info;
  320.     readln;
  321.     main;
  322.   end;
  323.  
  324.  
  325. PROCEDURE Ccccccc;
  326.   begin
  327.     setup;
  328.     suppl;
  329.     gotoxy(9,9);
  330.     write(' Ccccccc');
  331.     movecursor;
  332.     readln;
  333.     info;
  334.     readln;
  335.     main;
  336.   end;
  337.  
  338.  
  339. PROCEDURE Ddddddd;
  340.   begin
  341.     setup;
  342.     suppl;
  343.     gotoxy(9,9);
  344.     write(' Ddddddd');
  345.     movecursor;
  346.     readln;
  347.     info;
  348.     readln;
  349.     main;
  350.   end;
  351.  
  352.  
  353. PROCEDURE Eeeeeee;
  354.   begin
  355.     setup;
  356.     suppl;
  357.     gotoxy(9,9);
  358.     write(' Eeeeeee');
  359.     movecursor;
  360.     readln;
  361.     info;
  362.     readln;
  363.     main;
  364.   end;
  365.  
  366.  
  367. PROCEDURE Fffffff;
  368.   begin
  369.     setup;
  370.     suppl;
  371.     gotoxy(9,9);
  372.     write(' Fffffff');
  373.     movecursor;
  374.     readln;
  375.     info;
  376.     readln;
  377.     main;
  378.   end;
  379.  
  380.  
  381. PROCEDURE Ggggggg;
  382.   begin
  383.     setup;
  384.     suppl;
  385.     gotoxy(9,9);
  386.     write(' Ggggggg');
  387.     movecursor;
  388.     readln;
  389.     info;
  390.     readln;
  391.     main;
  392.   end;
  393.  
  394.  
  395. PROCEDURE Quit;
  396.   begin
  397.     halt;
  398.   end;
  399.  
  400.  
  401. (*
  402.   ===========================================================================
  403.   Writes menu items.  The menu items are dimensioned in datastr[i].
  404.   ===========================================================================
  405. *)
  406.  
  407. PROCEDURE Tabula;
  408.   var
  409.     mstr, nstr:      string;
  410.     max_lgth  :      integer;
  411.     max_number:      integer;
  412.  
  413.   begin
  414.     datastr[0]:= '<VMSCHM>';
  415.     datastr[1]:='  Aaaaaaa     ';
  416.     datastr[2]:='  Bbbbbbb     ';
  417.     datastr[3]:='  Ccccccc     ';
  418.     datastr[4]:='  Ddddddd     ';
  419.     datastr[5]:='  Eeeeeee     ';
  420.     datastr[6]:='  Fffffff     ';
  421.     datastr[7]:='  Ggggggg     ';
  422.     datastr[8]:='  Quit        ';
  423.  
  424.     mstr:=datastr[0];
  425.     gotoxy(7,7);
  426.     set_color(7,1);
  427.     write(mstr);
  428.  
  429.     max_number:=8;
  430.     wd_colm:=5;
  431.     wd_row:= 7;
  432.     for i:= 1 to  max_number do begin
  433.       gotoxy(wd_colm + 1, wd_row + i);
  434.       write(datastr[i]);
  435.     end;
  436.  
  437.     nstr:='<F1> for help';
  438.     gotoxy(6, 16);
  439.     set_color(7,1);
  440.     write(nstr);
  441.   end;
  442.  
  443.  
  444. (*
  445.   ===========================================================================
  446.   Floats the colored bar through the selections; checks  the keyboard for
  447.   specific keys; provides the choice [p].
  448.   ===========================================================================
  449. *)
  450.  
  451. PROCEDURE Selection;
  452.   var
  453.     max_number:    integer;
  454.     max_lgth:      integer;
  455.   begin
  456.     tabula;
  457.     p:=1;
  458.     max_number:=8;
  459.     max_lgth:=0;
  460.     tstr:=#0;                                 { Must not be changed ! }
  461.  
  462.  
  463.     for i:= 1 to max_number  do begin
  464.       if length(datastr[i]) > max_lgth then
  465.       max_lgth:= length(datastr[i]);
  466.       gotoxy(wd_colm +3, wd_row + i);
  467.       set_color(0,0);
  468.       write(spacestr(1));
  469.     end;
  470.  
  471.     while (tstr <> #27) and (tstr <> #13)  do begin
  472.       cl:= wd_colm + 1;
  473.       rw:= wd_row + p + 1;
  474.       xstr:= datastr[p];
  475.       gotoxy(cl, rw-1);
  476.       set_color(0,1);
  477.       gotoxy(cl, rw-1);
  478.       write(xstr);
  479.       setcursor(0,0);
  480.  
  481.       tstr:= readkey;
  482.       if tstr=#0 then begin
  483.         repeat
  484.           tstr:=readkey;
  485.           if tstr=#0 then tstr:= readkey;
  486.         until (tstr=#72) or (tstr=#80) or (tstr=#59) ;
  487.       end;
  488.  
  489.  
  490.       rw:= wd_row + p + 1;
  491.       cl:= wd_colm + 1;
  492.       gotoxy(cl, rw -1);
  493.       set_color(7,1);
  494.       write(xstr);
  495.  
  496.       if tstr= #27 then index:=0;
  497.       if tstr= #13 then index:=p;
  498.  
  499.       if tstr= #72 then dec(p);
  500.       if tstr= #80 then inc(p);
  501.  
  502.       if tstr= #71 then p:=1;
  503.       if tstr= #79 then p:= max_number;
  504.       if p < 1 then p:= max_number;
  505.       if p> max_number then p:=1;
  506.  
  507.       if tstr=#59 then help;
  508.  
  509.       for i:= 1 to max_number do begin
  510.         gotoxy(wd_colm + 3, wd_row + i);
  511.         set_color(0,0);
  512.         write(spacestr(1));
  513.       end;
  514.  
  515.       tstr:=upcase(tstr);
  516.       case tstr of
  517.       'A'        : Aaaaaaa;
  518.       'B'        : Bbbbbbb;
  519.       'C'        : Ccccccc;
  520.       'D'        : Ddddddd;
  521.       'E'        : Eeeeeee;
  522.       'F'        : Fffffff;
  523.       'G'        : Ggggggg;
  524.       'Q'        : Quit;
  525.       end;
  526.     end;
  527.   end;
  528.  
  529.  
  530. (*
  531.    ==========================================================================
  532.    It is added for the sake of simplicity; and  provides bar selection.
  533.    ==========================================================================
  534. *)
  535.  
  536.  
  537. PROCEDURE Main;
  538.   begin
  539.     setup;
  540.     status;
  541.     selection;
  542.     case p of
  543.     1:   begin
  544.            Aaaaaaa;
  545.          end;
  546.     2:   begin
  547.            Bbbbbbb;
  548.          end;
  549.     3:   begin
  550.            Ccccccc;
  551.          end;
  552.     4:   begin
  553.            Ddddddd;
  554.          end;
  555.     5:   begin
  556.            Eeeeeee;
  557.          end;
  558.     6:   begin
  559.            Fffffff;
  560.          end;
  561.     7:   begin
  562.            Ggggggg;
  563.          end;
  564.     8:   begin
  565.            Quit;
  566.          end;
  567.     end;
  568.   end;
  569.  
  570.  
  571. (*
  572.   ===========================================================================
  573.   Help can be called by any menu item; provides an information about the
  574.   program.  Notice the screen design.
  575.   ===========================================================================
  576. *)
  577.  
  578. PROCEDURE Help;
  579.   begin
  580.     info;
  581.     readln;
  582.     set_color(0,1);
  583.  
  584.     setup;
  585.  
  586.     set_color(1,0);
  587.     delay(400);
  588.     border(5, 5, 80,16, false);
  589.     set_color(1,1);
  590.     delay(400);
  591.     draw(6,5,35,14, #255);
  592.     delay(400);
  593.     set_color(7,4);
  594.     draw(9,6,32,12, #196);
  595.     set_color(1,7);
  596.     delay(400);
  597.     draw(11,7,30,1, #219);
  598.     delay(400);
  599.     draw(11,7,30,1, #178);
  600.     set_color(4,7);
  601.     delay(400);
  602.     draw(11,8,30,8, #186);
  603.     set_color(0,1);
  604.     delay(400);
  605.     draw(11,16,30,1, #176);
  606.     set_color(1,7);
  607.     delay(400);
  608.     draw(18,8,23,8, #220);
  609.     set_color(7,1);
  610.     delay(400);
  611.     draw(23,10,18,4, #254);
  612.     set_color(7,1);
  613.     delay(400);
  614.     draw(23,11, 13,2, #16);
  615.     set_color(0,1);
  616.     delay(400);
  617.     draw(34,11, 11,2, #255);
  618.     set_color(7,1);
  619.     delay(400);
  620.     draw(34,11,5,2, #221);
  621.     set_color(7,1);
  622.     delay(800);
  623.     draw(41,11,6,2, #255);
  624.     set_color(117,122);
  625.     delay(200);
  626.     gotoxy(41,12);
  627.     write(' VMSCHM ');
  628.     set_color(122,117);
  629.     delay(400);
  630.     draw(41,12,6,1, #255);
  631.     gotoxy(41,13);
  632.     set_color(1,1);
  633.     delay(400);
  634.     write('        ');
  635.     set_color(7,1);
  636.     delay(400);
  637.     draw(49,11,5,2, #17);
  638.     gotoxy(2,2);
  639.     set_color(7,4);
  640.     xstr:='This is an Help Message for ..';
  641.     delay(400);
  642.     write(centerstr(xstr, 78));
  643.     gotoxy(2,23);
  644.     set_color(7,4);
  645.     xstr:='Use <Enter> or <Esc> to return to Menu';
  646.     delay(400);
  647.     write(centerstr(xstr, 78));
  648.     delay(900);
  649.     boxdemo;
  650.  
  651.  
  652.  
  653.     while (tstr<>#13)   do begin
  654.       tstr:= #13;
  655.       tstr:=readkey;
  656.       main;
  657.     end;
  658.   end;
  659.  
  660. (*
  661.    ==========================================================================
  662.    Main Program.
  663.    ==========================================================================
  664. *)
  665.  
  666. Begin
  667.   clrscr;
  668.   save_screen;
  669.   main;
  670.   restore_screen;
  671. End.
  672.  
  673.