home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / BGIDEMO2.ZIP / TCMS10B.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-02-06  |  27.3 KB  |  1,007 lines
  1.                { copyright(1992) Roberts Reef Tech. }
  2. {***************************************************************************}
  3. {* 01-06-92 linked bgi and font in ;01-12-92 stopped mouse from flashing   *}
  4. {* 01-20-92 added timer and tweaking for speed ;01-26-92 tweaked entry     *}
  5. {* 02-02-92 keyboard buffer flushing added;02-06-92 BUTTON BUG WASTED      *}
  6. {* 02-10-92 added in Graphic demos;                                        *}
  7. {*                                                                         *}
  8. {*  last revised:02-06-92      filename:TCMS10B.PAS                        *}
  9. {***************************************************************************}
  10. program GUI_From_RRT;
  11. uses crt, graph, dos, bobmouse,BGIDriv,BGIFont;
  12. {$I a:hand.pas}
  13. var
  14.   Ahour, hour,
  15.   Aminute, minute,
  16.   Asecond, second,
  17.   Asec100, sec100 : word;
  18.   HourPassed, MinutePassed, SecondPassed : integer;
  19.   name : string;
  20.   swing, Horz, Vert, options, sysgraphadapter, sysgraphmode, graphdriver
  21.   , graphmode,x,y,P,D, c2,i,x1,y1,x2,y2 : integer;
  22.   width, crest, ypos, MSSize, SIZE, pointerX, pointerY, mx,my : word;
  23.   MSFile :file;
  24.   quit,right,both,left,lb,rb,bb, continue : boolean; 
  25.   ch : char;
  26.   POINT,exitsave,buffer : POINTER;
  27. {-------------------------------------------------------------------------}
  28. PROCEDURE CheckForMouse;
  29.  
  30. BEGIN
  31.   x1 := wherex;
  32.   y1 := wherey;
  33.   TextBackground(0);
  34.   TextColor(15);
  35.   write(' Checking for a mouse...'); { 24 char}
  36.   delay(750);
  37.   If not MouseIsInstalled then
  38.     begin
  39.       writeln(' This demo requires a mouse.');
  40.       writeln(' No mouse driver could be detected.');
  41.       halt(2);
  42.     end
  43.     else
  44.     begin
  45.       gotoxy(x1,y1);
  46.       
  47.       write(' A mouse is installed...'); { 24 char}
  48.       delay(750);
  49.     end;
  50.   writeln;
  51. end;
  52.  
  53.  
  54.  
  55. {-------------------------------------------------------------------------}
  56. PROCEDURE CheckForFiles;
  57. var
  58.  S: PATHSTR;
  59. BEGIN
  60.   x1 := wherex;
  61.   y1 := wherey;
  62.   TextBackground(0);
  63.   TextColor(15);
  64.   write(' Checking for files...'); 
  65.   delay(750);
  66.   S := FSEARCH('box9.tps',GETENV('PATH'));
  67.   IF S = '' THEN
  68.   
  69.     begin
  70.       writeln;
  71.       writeln(' This demo requires a file.');
  72.       writeln(' The file Box9.tps could not be found.');
  73.       halt(2);
  74.     end
  75.     else
  76.     begin
  77.       gotoxy(x1,y1);
  78.       
  79.       write(' All files found...   '); 
  80.       delay(750);
  81.     end;
  82.   writeln;
  83. end;
  84. {-------------------------------------------------------------------------}
  85. function EGAthere: boolean;
  86.  
  87. begin
  88.   detectgraph(sysgraphadapter, sysgraphmode);
  89.   if sysgraphadapter = 3 or 9 then EGAthere := true; {ega or vga}
  90. end;
  91. {-------------------------------------------------------------------------}
  92. PROCEDURE CheckForEGA;
  93.  
  94. BEGIN
  95.   x1 := wherex;
  96.   y1 := wherey;
  97.   write(' Checking for EGA...    ');
  98.   delay(800);                { the delay is just to give the user }
  99.   If not EGAthere then        { time to read the screen }
  100.     begin
  101.       writeln(' This demo requires EGA 640x350x16 graphics.');
  102.       writeln(' EGA or capatible graphics could not be detected.');
  103.       halt(2);
  104.     end
  105.     else
  106.     begin
  107.       gotoxy(x1,y1);
  108.       
  109.       write(' EGA is installed...');
  110.       delay(800);
  111.     end;
  112.   writeln;
  113. end;
  114. {-------------------------------------------------------------------------}
  115. procedure Abort(Msg : string);
  116. begin
  117.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  118.   Halt(1);
  119. end;
  120. {-------------------------------------------------------------------------}
  121. procedure startthetimer (message : string);
  122. begin
  123.   writeln;
  124.   writeln(message);
  125.   gettime( Ahour, Aminute,Asecond,Asec100);
  126. end;
  127.  
  128. {-------------------------------------------------------------------------}
  129.  
  130. procedure endthetimer(message : string);
  131. begin
  132.   gettime(hour,minute,second,sec100);
  133.   HourPassed := hour - Ahour;
  134.   Minutepassed := minute - Aminute;
  135.   Secondpassed := second - Asecond;
  136.   if hour < Ahour then
  137.     Hourpassed := hourpassed + 24;
  138.   if minute < Aminute then begin
  139.     minutepassed := minutepassed + 60;
  140.     Hourpassed := hourpassed -1;
  141.   end;
  142.   if Second < Asecond then begin
  143.     secondpassed := secondpassed + 60;
  144.     minutepassed := minutepassed -1;
  145.   end;
  146.   writeln;
  147.   TextBackground(1);
  148.   TextColor(15);
  149.   if Hourpassed > 0 then
  150.     write(Message,'Active for ',hourpassed,' Hour(s) ',minutepassed,' Minute(s) ',secondpassed,' Second(s).');
  151.   if Hourpassed = 0 then
  152.     Begin
  153.        if Minutepassed > 0 then
  154.        write(Message,'Active for ',minutepassed,' Minute(s) ',secondpassed,' Second(s).',#13);
  155.        if Minutepassed = 0 then
  156.        write(Message,'Active for ',secondpassed,' Second(s).',#13);
  157.     end;
  158.   normvideo;
  159.   sound(10000);
  160.   delay(100);
  161.   nosound;
  162.   writeln;
  163. end;
  164. {----------------------------------------------------------------------------}
  165.  PROCEDURE FlushKey;
  166.  
  167. VAR
  168.   Regs : Registers;  { USES DOS unit! }
  169.  
  170. BEGIN
  171.   Regs.AH := $01;            { AH=1: Check for keystroke }
  172.   Intr($16,Regs);            { Interrupt $16: Keyboard services}
  173.   IF (Regs.Flags AND $0040) = 0 THEN  { If chars in buffer }
  174.     REPEAT
  175.       Regs.AH := 0;          { Char is ready; go read it... }
  176.       Intr($16,Regs);        { ...using AH = 0: Read Char }
  177.       Regs.AH := $01;        { Check for another keystroke... }
  178.       Intr($16,Regs);        { ...using AH = 1 }
  179.     UNTIL (Regs.Flags AND $0040) <> 0;
  180. END;
  181. {--------------------------------------------------------------------------}
  182.  
  183. procedure initega;
  184. { Initializes EGA 640x350x16 graphics if an EGA or VGA card is detected. }
  185. var
  186.   grapherror : integer;
  187.  
  188. begin
  189.   
  190.   if EGAthere then
  191.   begin
  192.     if RegisterBGIfont(@SansSerifFontProc) < 0 then
  193.     Abort('SansSerif');
  194.     if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  195.        Abort('EGA/VGA');
  196.     graphdriver := 3;
  197.     graphmode := 1;
  198.     initgraph(graphdriver, Graphmode,'');
  199.     highvideo;
  200.     Grapherror := graphresult;
  201.     if grapherror <> 0 then
  202.     begin
  203.       writeln('Error initializing graphics:',Grapherrormsg(grapherror));
  204.       halt(1);
  205.     end;
  206.   end;
  207. end;
  208. {-------------------------------------------------------------------------}
  209. {$F+}
  210. procedure mcedemoexit;
  211. begin
  212.   exitproc := exitsave;
  213.   hidemouse;
  214.   closegraph;
  215.   textbackground(0);
  216.   endthetimer(' BGI DEMO ');
  217. end;
  218. {$F-}
  219. {-----------------------------------------------------------------------------}
  220.  
  221. Procedure Idle;
  222. Begin
  223.    Options := 0;
  224.    continue := false;
  225. repeat
  226.    
  227.    pollmouse(mx,my,lb,rb,bb);
  228.    
  229.    
  230.    if lb then {start of Example one button}
  231.     begin
  232.     case my of
  233.         40..65 :
  234.           begin
  235.             case mx of
  236.               10..35 : begin
  237.                            setcolor(1);
  238.                            setfillstyle(1,9); {9}
  239.                            hidemouse;
  240.                            bar3d(10,40,34,65,1,topoff);
  241.                            delay(2000);
  242.                            
  243.                            continue := true;
  244.                            options := 7;
  245.                          end;
  246.               else continue := false;
  247.  
  248.             end; {case mx}
  249.           end;
  250.               else continue := false;
  251.        end; {case my}
  252.     end;{if lb and open button }
  253.  {*******************************************2222222*******}
  254.    if lb then  {start Example two button }
  255.     begin
  256.     case my of
  257.         70..95:
  258.           begin
  259.             case mx of
  260.               10..35 : begin
  261.                            setcolor(1);
  262.                            setfillstyle(1,9); {9}
  263.                            hidemouse;
  264.                            bar3d(10,70,34,95,1,topoff);
  265.                            delay(2000);
  266.                            
  267.                            continue := true;
  268.                            options := 8;
  269.                          end;
  270.               else continue := false;
  271.  
  272.             end; {case mx}
  273.           end;
  274.               else continue := false;
  275.        end; {case my}
  276.     end;{if lb and two button }
  277.   {*******************************************3333333***************}
  278.    if lb then  {start Example three button }
  279.     begin
  280.     case my of
  281.         100..125:
  282.           begin
  283.             case mx of
  284.               10..35 : begin
  285.                            setcolor(1);
  286.                            setfillstyle(1,9); {9}
  287.                            hidemouse;
  288.                            bar3d(10,100,34,125,1,topoff);
  289.                            delay(2000);
  290.                            
  291.                            continue := true;
  292.                            options := 9;
  293.                          end;
  294.               else continue := false;
  295.  
  296.             end; {case mx}
  297.           end;
  298.               else continue := false;
  299.           end; {case my}
  300.     end;{if lb and three button }
  301.   {********************************************444444************}
  302.     if lb then  {start of Example four button }
  303.     begin
  304.     case my of
  305.         130..155:
  306.           begin
  307.             case mx of
  308.               10..35   : begin
  309.                            setcolor(1);
  310.                            setfillstyle(1,9); {9}
  311.                            hidemouse;
  312.                            bar3d(10,130,34,155,1,topoff);
  313.                            delay(2000);
  314.                            
  315.                            continue := true;
  316.                            options := 10;
  317.                          end;
  318.               else continue := false;
  319.               end; {case mx}
  320.           end;
  321.               else continue := false;
  322.        end; {case my}
  323.     end;{if lb and abort button }
  324.   {*****************************************555555***************}
  325.     if lb then  {start example 5 button }
  326.     begin
  327.     case my of
  328.         160..185:
  329.           begin
  330.             case mx of
  331.               10..35 : begin
  332.                            setcolor(1);
  333.                            setfillstyle(1,9); {9}
  334.                            hidemouse;
  335.                            bar3d(10,160,34,185,1,topoff);
  336.                            delay(2000);
  337.                            
  338.                            continue := true;
  339.                            options := 11;
  340.                          end;
  341.               else continue := false;
  342.             end; {case mx}
  343.           end;
  344.               else continue := false;
  345.        end; {case my}
  346.     end;{if lb and quit button }
  347.   {*********************************************}
  348.   {*****************************************666666***************}
  349.     if lb then  {start example 6 button }
  350.     begin
  351.     case my of
  352.         190..215:
  353.           begin
  354.             case mx of
  355.               10..35 : begin
  356.                            setcolor(1);
  357.                            setfillstyle(1,9); {9}
  358.                            hidemouse;
  359.                            bar3d(10,190,34,215,1,topoff);
  360.                            delay(2000);
  361.                            
  362.                            continue := true;
  363.                            options := 12;
  364.                          end;
  365.               else continue := false;
  366.             end; {case mx}
  367.           end;
  368.               else continue := false;
  369.        end; {case my}
  370.     end;{if lb and quit button }
  371.   {*********************************************}
  372.   {*****************************************777777***************}
  373.     if lb then  {start example 7 button }
  374.     begin
  375.     case my of
  376.         220..245:
  377.           begin
  378.             case mx of
  379.               10..35 : begin
  380.                            setcolor(1);
  381.                            setfillstyle(1,9); {9}
  382.                            hidemouse;
  383.                            bar3d(10,220,34,245,1,topoff);
  384.                            delay(2000);
  385.                            
  386.                            continue := true;
  387.                            options := 14;
  388.                          end;
  389.               else continue := false;
  390.             end; {case mx}
  391.           end;
  392.               else continue := false;
  393.        end; {case my}
  394.     end;{if lb and quit button }
  395.   {*********************************************}
  396.   {*****************************************888888***************}
  397.     if lb then  {start example 8 button }
  398.     begin
  399.     case my of
  400.         250..275:
  401.           begin
  402.             case mx of
  403.               10..35 : begin
  404.                            setcolor(1);
  405.                            setfillstyle(1,9); {9}
  406.                            hidemouse;
  407.                            bar3d(10,250,34,275,1,topoff);
  408.                            delay(2000);
  409.                            
  410.                            continue := true;
  411.                            options := 2;
  412.                          end;
  413.               else continue := false;
  414.             end; {case mx}
  415.           end;
  416.               else continue := false;
  417.        end; {case my}
  418.     end;{if lb and quit button }
  419.   {*********************************************}
  420.   {*****************************************999999***************}
  421.     if lb then  {start example 9 button }
  422.     begin
  423.     case my of
  424.         280..305:
  425.           begin
  426.             case mx of
  427.               10..35 : begin
  428.                            setcolor(1);
  429.                            setfillstyle(1,9); {9}
  430.                            hidemouse;
  431.                            bar3d(10,280,34,305,1,topoff);
  432.                            delay(2000);
  433.                            
  434.                            continue := true;
  435.                            options := 4;
  436.                          end;
  437.               else continue := false;
  438.             end; {case mx}
  439.           end;
  440.               else continue := false;
  441.        end; {case my}
  442.     end;{if lb and quit button }
  443.   {*********************************************}
  444.   {*****************************************1010101010***********}
  445.     if lb then  {start of example 10 button }
  446.     begin
  447.     case my of
  448.         310..335:
  449.           begin
  450.             case mx of
  451.               10..35 : begin
  452.                            setcolor(1);
  453.                            setfillstyle(1,9); {9}
  454.                            hidemouse;
  455.                            bar3d(10,310,34,335,1,topoff);
  456.                            delay(2000);
  457.                            
  458.                            continue := true;
  459.                            options := 5;
  460.                          end;
  461.               else continue := false;
  462.             end; {case mx}
  463.           end;
  464.               else continue := false;
  465.        end; {case my}
  466.     end;{if lb and quit button }
  467.   {*********************************************}
  468.    
  469. until options >=1  ;
  470. end;
  471. {-------------------------------------------------------------------------}
  472. procedure fglass;
  473. VAR
  474.   I,Color     : Integer;
  475.   Palette     : PaletteType;
  476.   ch : char;
  477.  
  478. BEGIN
  479.   Randomize;
  480.   GetPalette(Palette);
  481.   FOR Color := 0 TO 2000 DO
  482.     BEGIN
  483.       SetColor(Random(Palette.Size));
  484.       Line(Random(GetMaxX),Random(GetMaxY),Random(GetMaxX),Random(GetMaxY));
  485.       REPEAT I := Random(Palette.Size) UNTIL I <> 0;
  486.     SetPalette(I,Random(Palette.Size));
  487.     
  488.     END;
  489.     
  490.     
  491.   
  492.  
  493.  
  494. END;
  495.  
  496. procedure LoadMysprite;
  497.    begin
  498.     Assign(MSFile,'box9.TPS');
  499.     reset(MSFILE,1);
  500.     MSSize:=ImageSize(0,0,24,24);{this file only maxsize}
  501.     GetMem(buffer,MSSize);
  502.     BlockRead(MSFile,buffer^,MSSize);
  503.     Close(MSFile);
  504.    end;
  505.  
  506. {-------------------------------------------------------------------------}
  507. procedure rrtbox; {revised 01-06-92}
  508.  var
  509.   RRTLeft, RRTVert : integer;
  510.   page:word;
  511.  
  512.         begin
  513.          RRTleft := 10;
  514.          RRTVert := 10;
  515.          setvisualpage(1);
  516.          setactivepage(0);
  517.          setcolor(4);
  518.          Rectangle(0,0, 310, 345 );
  519.          setfillstyle(solidfill,Darkgray);
  520.          floodfill(5,5,red);
  521.         { PutImage(RRTLeft,RRTVert,buffer^,normalput);}          {one}
  522.          PutImage(RRTLeft,RRTVert+30,buffer^,normalput);       {two}
  523.          PutImage(RRTLeft,RRTVert+60,buffer^,normalput);       {three}
  524.          PutImage(RRTLeft,RRTVert+90,buffer^,normalput);       {four}
  525.          PutImage(RRTLeft,RRTVert+120,buffer^,normalput);      {five}
  526.          PutImage(RRTLeft,RRTVert+150,buffer^,normalput);      {six}
  527.          PutImage(RRTLeft,RRTVert+180,buffer^,normalput);      {seven}
  528.          PutImage(RRTLeft,RRTVert+210,buffer^,normalput);      {eight}
  529.          PutImage(RRTLeft,RRTVert+240,buffer^,normalput);      {nine}
  530.          PutImage(RRTLeft,RRTVert+270,buffer^,normalput);      {ten}
  531.          PutImage(RRTLeft,RRTVert+300,buffer^,normalput);      {eleven}
  532.          
  533.          
  534.          setcolor(15);
  535.          Rectangle(rrtleft+30,rrtvert,rrtleft+280, rrtvert+324 );
  536.          line(40,37,290,37);
  537.          line(40,67,290,67);
  538.          line(40,97,290,97);
  539.          line(40,127,290,127);
  540.          line(40,157,290,157);
  541.          line(40,187,290,187);
  542.          line(40,217,290,217);
  543.          line(40,247,290,247);
  544.          line(40,277,290,277);
  545.          line(40,307,290,307);
  546.          setcolor(14);
  547.          SetTextStyle(sansserifFont, HorizDir, 4);
  548.          moveto(50,2);
  549.          outtext('   BGI DEMO ');
  550.          MOVETO(50,30);
  551.          OUTTEXT('Sectors');
  552.          MOVETO(50,60);
  553.          OUTTEXT('Writemode');
  554.          MOVETO(50,90);
  555.          OUTTEXT('Ellipse');
  556.          MOVETO(50,120);
  557.          OUTTEXT('CRT');
  558.          MOVETO(50,150);
  559.          OUTTEXT('Putpixel');
  560.          MOVETO(50,180);
  561.          OUTTEXT('Circles');
  562.          MOVETO(50,210);
  563.          OUTTEXT('AspectRatio');
  564.          MOVETO(50,240);
  565.          OUTTEXT('Fiberglass');
  566.          MOVETO(50,270);
  567.          OUTTEXT('Helix');
  568.          MOVETO(50,300);
  569.          OUTTEXT('Exit');
  570.          
  571.          setvisualpage(0);
  572.         end;
  573. {---------------------------------------------------------------------------}
  574. procedure helix;
  575. begin
  576.   
  577.   ypos := getmaxy div 2;
  578.   crest := getmaxy div 8;
  579.   width := getmaxx;
  580.   for i := 0 to width do begin
  581.     swing := round(crest * sin(10*pi*i / width ) );
  582.     putpixel (i,ypos + swing, i mod 25 );
  583.     putpixel (i,ypos - swing, (getpixel( i, ypos + swing ) +8 ) mod 15 );
  584.   end;
  585.   
  586.   end;
  587. {-------------------------------------------------------------------------}
  588. procedure AspectRatioPlay;
  589. { Demonstrate  SetAspectRatio command }
  590. var
  591.   ViewInfo   : ViewPortType;
  592.   CenterX    : integer;
  593.   CenterY    : integer;
  594.   Radius     : word;
  595.   Xasp, Yasp : word;
  596.   i          : integer;
  597.   RadiusStep : word;
  598. begin
  599.   
  600.   GetViewSettings(ViewInfo);
  601.   with ViewInfo do
  602.   begin
  603.     CenterX := (x2-x1) div 2;
  604.     CenterY := (y2-y1) div 2;
  605.     Radius := 3*((y2-y1) div 5);
  606.   end;
  607.   RadiusStep := (Radius div 30);
  608.   Circle(CenterX, CenterY, Radius);
  609.   GetAspectRatio(Xasp, Yasp);
  610.   for i := 1 to 30 do
  611.   begin
  612.     SetAspectRatio(Xasp, Yasp+(I*GetMaxX));    { Increase Y aspect factor }
  613.     Circle(CenterX, CenterY, Radius);
  614.     Dec(Radius, RadiusStep);                   { Shrink radius }
  615.   end;
  616.   Inc(Radius, RadiusStep*30);
  617.   for i := 1 to 30 do
  618.   begin
  619.     SetAspectRatio(Xasp+(I*GetMaxX), Yasp);    { Increase X aspect factor }
  620.     if Radius > RadiusStep then
  621.       Dec(Radius, RadiusStep);                 { Shrink radius }
  622.     Circle(CenterX, CenterY, Radius);
  623.   end;
  624.   SetAspectRatio(Xasp, Yasp);                  { back to original aspect }
  625.   delay(6000);
  626. end; { AspectRatioPlay }
  627.  
  628. {---------------------------------------------------------------------------}
  629. function RandColor : word;
  630. { Returns a Random non-zero color value that is within the legal
  631.   color range for the selected device driver and graphics mode.
  632.   MaxColor is set to GetMaxColor by Initialize }
  633. var
  634.   MaxColor    : word;
  635. begin
  636.   RandColor := Random(MaxColor)+1;
  637. end; { RandColor }
  638.  
  639. procedure CirclePlay;
  640. { Draw random circles on the screen }
  641. var
  642.   MaxRadius : word;
  643.   MaxX, MaxY  : word;
  644. begin
  645.   maxx := 640;
  646.   maxy := 350;
  647.   
  648.   MaxRadius := MaxY div 10;
  649.   SetLineStyle(SolidLn, 0, NormWidth);
  650.   repeat
  651.     SetColor(RandColor);
  652.     Circle(Random(MaxX), Random(MaxY), Random(MaxRadius));
  653.   until KeyPressed;
  654.   Delay(6000);
  655. end; { CirclePlay }
  656.  
  657. procedure SectorPlay;
  658. { Draw random sectors on the screen }
  659. const
  660.   MaxFillStyles = 12; { patterns 0..11 }
  661. var
  662.   MaxRadius : word;
  663.   FillColor : integer;
  664.   EndAngle  : integer;
  665.   maxx,maxy : word;
  666. begin
  667.   randomize;
  668.   maxx := 640;
  669.   maxy := 350;
  670.   MaxRadius := MaxY div 17;
  671.   SetLineStyle(SolidLn, 0, NormWidth);
  672.   repeat
  673.     FillColor := RandColor;
  674.     SetColor(FillColor);
  675.     SetFillStyle(Random(MaxFillStyles), FillColor);
  676.     EndAngle := Random(360);
  677.     Sector(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle,
  678.            Random(MaxRadius), Random(MaxRadius));
  679.   until KeyPressed;
  680.   delay(6000);
  681. end; { SectorPlay }
  682.  
  683.  
  684. procedure WriteModePlay;
  685. { Demonstrate the SetWriteMode procedure for XOR lines }
  686. const
  687.   DelayValue = 5;  { milliseconds to delay }
  688. var
  689.   ViewInfo      : ViewPortType;
  690.   Color         : word;
  691.   Left, Top     : integer;
  692.   Right, Bottom : integer;
  693.   Step          : integer; { step for rectangle shrinking }
  694. begin
  695.   
  696.   GetViewSettings(ViewInfo);
  697.   Left := 0;
  698.   Top := 0;
  699.   with ViewInfo do
  700.   begin
  701.     Right := x2-x1;
  702.     Bottom := y2-y1;
  703.   end;
  704.   Step := Bottom div 25;
  705.   SetColor(GetMaxColor);
  706.   Line(Left, Top, Right, Bottom);
  707.   Line(Left, Bottom, Right, Top);
  708.   SetWriteMode(XORPut);                    { Set XOR write mode }
  709.   repeat
  710.     Line(Left, Top, Right, Bottom);        { Draw XOR lines }
  711.     Line(Left, Bottom, Right, Top);
  712.     Rectangle(Left, Top, Right, Bottom);   { Draw XOR rectangle }
  713.     Delay(DelayValue);                     { Wait }
  714.     Line(Left, Top, Right, Bottom);        { Erase lines }
  715.     Line(Left, Bottom, Right, Top);
  716.     Rectangle(Left, Top, Right, Bottom);   { Erase rectangle }
  717.     if (Left+Step < Right) and (Top+Step < Bottom) then
  718.       begin
  719.         Inc(Left, Step);                  { Shrink rectangle }
  720.         Inc(Top, Step);
  721.         Dec(Right, Step);
  722.         Dec(Bottom, Step);
  723.       end
  724.     else
  725.       begin
  726.         Color := RandColor;                { New color }
  727.         SetColor(Color);
  728.         Left := 0;                         { Original large rectangle }
  729.         Top := 0;
  730.         with ViewInfo do
  731.         begin
  732.           Right := x2-x1;
  733.           Bottom := y2-y1;
  734.         end;
  735.       end;
  736.   until KeyPressed;
  737.   SetWriteMode(CopyPut);                   { back to overwrite mode }
  738.   Delay(60);
  739. end; { WriteModePlay }
  740.  
  741. procedure FillEllipsePlay;
  742. { Random filled ellipse demonstration }
  743. const
  744.   MaxFillStyles = 12; { patterns 0..11 }
  745. var
  746.   MaxRadius : word;
  747.   FillColor : integer;
  748.   maxx,maxy : word;
  749.  
  750. begin
  751.   maxx := 640;
  752.   maxy := 350;
  753.   MaxRadius := MaxY div 10;
  754.   SetLineStyle(SolidLn, 0, NormWidth);
  755.   repeat
  756.     FillColor := RandColor;
  757.     SetColor(FillColor);
  758.     SetFillStyle(Random(MaxFillStyles), FillColor);
  759.     FillEllipse(Random(MaxX), Random(MaxY),
  760.                 Random(MaxRadius), Random(MaxRadius));
  761.   until KeyPressed;
  762.   delay(5000);
  763. end; { FillEllipsePlay }
  764.  
  765. procedure PutPixelPlay;
  766. { Demonstrate the PutPixel and GetPixel commands }
  767. const
  768.   Seed   = 1962; { A seed for the random number generator }
  769.   NumPts = 2000; { The number of pixels plotted }
  770.   Esc    = #27;
  771. var
  772.   I : word;
  773.   X, Y, Color : word;
  774.   XMax, YMax  : integer;
  775.   ViewInfo    : ViewPortType;
  776. begin
  777.   
  778.  
  779.   GetViewSettings(ViewInfo);
  780.   with ViewInfo do
  781.   begin
  782.     XMax := (x2-x1-1);
  783.     YMax := (y2-y1-1);
  784.   end;
  785.  
  786.   while not KeyPressed do
  787.   begin
  788.     { Plot random pixels }
  789.     RandSeed := Seed;
  790.     I := 0;
  791.     while (not KeyPressed) and (I < NumPts) do
  792.     begin
  793.       Inc(I);
  794.       PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  795.     end;
  796.  
  797.     { Erase pixels }
  798.     RandSeed := Seed;
  799.     I := 0;
  800.     while (not KeyPressed) and (I < NumPts) do
  801.     begin
  802.       Inc(I);
  803.       X := Random(XMax)+1;
  804.       Y := Random(YMax)+1;
  805.       Color := GetPixel(X, Y);
  806.       if Color = RandColor then
  807.         PutPixel(X, Y, 0);
  808.     end;
  809.   end;
  810.   delay(5000);
  811. end; { PutPixelPlay }
  812.  
  813.  
  814. {---------------------------------------------------------------------------}
  815.  
  816. procedure dooptions;
  817.  begin
  818.     flushkey;
  819.    
  820.     if options = 7 then
  821.       begin
  822.         setactivepage(1);
  823.         setvisualpage(1);
  824.         clearviewport;
  825.         Sectorplay;
  826.         delay(999);
  827.         sound(4000);
  828.         delay(100);
  829.         nosound;
  830.         clearviewport;
  831.         setactivepage(0);
  832.         setvisualpage(0);
  833.  
  834.  
  835.        
  836.       end;
  837.       if options = 8 then
  838.       begin
  839.         setactivepage(1);
  840.         setvisualpage(1);
  841.         clearviewport;
  842.         writemodeplay;
  843.         delay(999);
  844.         sound(4000);
  845.         delay(100);
  846.         nosound;
  847.         clearviewport;
  848.         setactivepage(0);
  849.         setvisualpage(0);
  850.  
  851.  
  852.       end;
  853.       if options = 9 then
  854.       begin
  855.        setactivepage(1);
  856.         setvisualpage(1);
  857.         clearviewport;
  858.         fillellipseplay;
  859.         delay(999);
  860.         sound(4000);
  861.         delay(100);
  862.         nosound;
  863.         clearviewport;
  864.         setactivepage(0);
  865.         setvisualpage(0);
  866.  
  867.  
  868.        
  869.       end;
  870.      if options = 10 then
  871.       begin
  872.        
  873.        clearviewport;
  874.        RestoreCRTMode;
  875.        writeln('This is text mode .......!');
  876.        writeln('press enter to exit ');
  877.        readln;
  878.        
  879.        
  880.  
  881.  
  882.  
  883.       end;
  884.     if options = 11 then
  885.       begin
  886.         setactivepage(1);
  887.         setvisualpage(1);
  888.         clearviewport;
  889.         putpixelplay;
  890.         delay(999);
  891.         sound(4000);
  892.         delay(100);
  893.         nosound;
  894.         clearviewport;
  895.         setactivepage(0);
  896.         setvisualpage(0);
  897.  
  898.  
  899.       end;
  900.     if options = 12 then  {six}
  901.       begin
  902.         setactivepage(1);
  903.         setvisualpage(1);
  904.         clearviewport;
  905.         Circleplay;
  906.         delay(999);
  907.         sound(4000);
  908.         delay(100);
  909.         nosound;
  910.         clearviewport;
  911.         setactivepage(0);
  912.         setvisualpage(0);
  913.  
  914.  
  915.       end;
  916.     if options = 14 then  {seven}
  917.       begin
  918.        setactivepage(1);
  919.         setvisualpage(1);
  920.         clearviewport;
  921.         aspectratioplay;
  922.         delay(999);
  923.         sound(4000);
  924.         delay(100);
  925.         nosound;
  926.         clearviewport;
  927.         setactivepage(0);
  928.         setvisualpage(0);
  929.         
  930.  
  931.        
  932.       end;
  933.     if options = 2 then
  934.       begin
  935.         setactivepage(1);
  936.         setvisualpage(1);
  937.         clearviewport;
  938.         fglass;
  939.         delay(999);
  940.         sound(4000);
  941.         delay(100);
  942.         nosound;
  943.         clearviewport;
  944.         setactivepage(0);
  945.         setvisualpage(0);
  946.  
  947.  
  948.  
  949.       end;
  950.     
  951.       
  952.     if options = 4 then
  953.       begin
  954.         setactivepage(1);
  955.         setvisualpage(1);
  956.         clearviewport;
  957.         helix;
  958.         delay(999);
  959.         sound(4000);
  960.         delay(100);
  961.         nosound;
  962.         clearviewport;
  963.         setactivepage(0);
  964.         setvisualpage(0);
  965.         
  966.  
  967.       end;
  968.     if options = 5 then
  969.       begin
  970.        sound(300);
  971.        delay(100);
  972.        nosound;
  973.        
  974.        exit;
  975.       end;
  976.  
  977.   
  978.  
  979.  repeat
  980.  
  981.  setgraphmode(graphmode);
  982.  rrtbox;
  983.  showmouse;
  984.  handmouse;
  985.  idle;
  986.  dooptions;
  987.  until options = 5 ;
  988.  end;
  989. {-------------------------------------------------------------------------}
  990.                        { copyright(1992) Roberts Reef Tech. }
  991. Begin
  992.  startthetimer(' ');
  993.  clrscr;
  994.  Checkformouse;
  995.  CheckforEGa;
  996.  CheckforFiles;
  997.  Initega;
  998.  LoadMysprite;
  999.  rrtbox;
  1000.  mousereset;
  1001.  showmouse;
  1002.  handmouse;
  1003.  idle;
  1004.  dooptions;
  1005.  exitsave := exitproc;          { Saves current exit procedure. }
  1006.  exitproc := @mcedemoexit;      { Installs my exit procedure. }
  1007. end.