home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GPMENU.ZIP / GMDEMO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-04-01  |  4.3 KB  |  156 lines
  1.  
  2. program GraphicMenuDemo;
  3. uses tpcrt,
  4.      graph,
  5.      gpmenu,
  6.      gxmenu;
  7.                                {frame,header,body,select,key,help}
  8. const color1 : menucolorarray = ($07,  $07,  $03,  $1E,  $0B, $0E);
  9.       frame1 : framearray=#201#200#187#188#205#186;
  10.       frame2 : framearray=#203#200#203#188#205#186;
  11.       frameL : framearray=#255#255#255#255#255#255;
  12.  
  13. var ch : char;
  14.     main : menu;
  15.     key : menukey;
  16.     f1, f2 : framearray;
  17.     ii, i : integer;
  18.     grdriver, grmode, errcode : integer;
  19.     SolidF : Boolean;
  20.  
  21. {------------------------------}
  22. {--- define the menu system ---}
  23. procedure initmenu(var M:menu);
  24.  
  25. Begin
  26.   M:= Newmenu([],nil);
  27.   submenu(1,2,1,horizontal,f1,color1,'GDMENU');
  28.     menuitem('Frame',2,1,1,'Select framing mode');
  29.     submenu(2,4,1,vertical,f2,color1,'Mode');
  30.       menuitem('Framed ',1,1,11,'I''ve been framed!');
  31.       menuitem('Plain',2,1,12,'No frames here Boss');
  32.       menuitem('Graph',3,1,13,'Graphics mode');
  33.       menuitem('Text',4,1,14,'Text mode');
  34.       menuitem('Hatch',5,1,15,'Draw hatched background');
  35.       menuitem('Solid',6,1,16,'Draw solid background');
  36.       popsublevel;
  37.     menuitem('Disposition',12,1,2,'What to do');
  38.     submenu(11,4,1,vertical,f2,color1,'Action');
  39.       menuitem('Ignore',1,1,255,'Do nothing');
  40.       menuitem('Exit',2,1,50,'Exit from GMDemo');
  41.       popsublevel;
  42.     popsublevel;
  43.   resetmenu(m);
  44. end;
  45.  
  46. {-------------------------------------}
  47. {misc support procedures}
  48. function fstr(i:integer):string;
  49. var stemp:string;
  50. begin
  51.   str(i,stemp);
  52.   fstr:=stemp;
  53. end;
  54.  
  55. procedure DoHatch(C:byte);
  56. begin
  57.    if GraphOn then
  58.    begin
  59.      SetColor(C);
  60.      if SolidF then
  61.        SetFillStyle(SolidFill,C)
  62.      else
  63.        SetFillStyle(XHatchFill,C);
  64.      bar(0,0,GetMaxX,GetMaxY);
  65.      rectangle(0,0,GetMaxX,GetMaxY);
  66.    end
  67.    else
  68.    begin
  69.      for ii := 1 to 25 do
  70.      begin
  71.        For i := 1 to 79 do
  72.          if SolidF then
  73.            GTWrite(#219, ii, i, C)
  74.          else
  75.            GTWrite(#176, ii, i, C);
  76.      end;
  77.    end;
  78.    GTWrite('   ', 16, 1, 7);
  79.    for i := 1 to 15 do  {show all the colors available}
  80.      GTWrite(fstr(i)+' ', 16, (i*2)+1, i);
  81. end;
  82.  
  83. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  84. { Here we go! }
  85.  
  86. begin
  87.   grdriver := Detect;        { init for Borland graphics }
  88. {  grdriver := cga;       grmode := cgac2;  }     {forced overrides}
  89. {  grdriver := hercmono;  grmode := hercmonohi; }
  90.  
  91.   initgraph(grdriver, grmode,'');
  92.   Errcode := GraphResult;
  93.   if errcode <> Grok then
  94.   begin
  95.      writeln('Error ',grapherrormsg(errcode),' - Graphic driver not properly installed');
  96.      halt;
  97.   end;
  98.   GraphOn := true; {Mark that we are now in graph mode}
  99.  
  100.   SolidF := false;
  101.   DoHatch(Blue);  {put a back drop out there}
  102.  
  103. {-------------------}
  104.  
  105.    f1 := frame1;   {initialize stuff}
  106.    f2 := frame2;
  107.    initmenu(main);
  108.  
  109.    repeat         {if menu not visible MenuChoice will draw it first}
  110.       key := menuchoice(main,ch); {pick something from the menu}
  111.       GTWrite('Selection='+fstr(key)+' with keystroke code of '+fstr(ord(ch)),24,1,white);
  112.       {delay 1000}
  113.       erasemenu(main, false);
  114.       if (Key > 10) and (Key < 100) then
  115.       begin
  116.          case Key of
  117.            11 : begin
  118.                   f1 := frame1;           {use frames}
  119.                   f2 := frame2;
  120.                 end;
  121.            12 : begin
  122.                   f1 := frameL;           {don't use frames}
  123.                   f2 := frameL;
  124.                 end;
  125.            13 : begin
  126.                   if not(GraphOn) then    {go to graph mode}
  127.                      SetGraphMode(grMode);
  128.                   GraphOn := true;
  129.                 end;
  130.            14 : begin
  131.                   if GraphOn then         {go to text mode}
  132.                      RestoreCrtMode;
  133.                   GraphOn := false;
  134.                 end;
  135.            15 : begin
  136.                   SolidF := false;
  137.                   DoHatch(Blue);         {show a hatched backdrop}
  138.                 end;
  139.            16 : begin
  140.                   SolidF := true;         {show a solid backdrop}
  141.                   DoHatch(Blue);
  142.                 end;
  143.          end; {case Key of}
  144.          initmenu(main);
  145.       end;
  146.    until (ch=^M) and (key=50);
  147.  
  148. {---------------------}
  149. {That's all folks!}
  150.  
  151.    If GraphOn then
  152.      CloseGraph;
  153.  
  154. end.
  155.  
  156.