home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / p / prbgi097.zip / PASCAL.ZIP / BGIDEMO.PAS next >
Pascal/Delphi Source File  |  1992-12-15  |  49KB  |  1,740 lines
  1. {  This program is not mine.
  2.     It was included with Turbo Pascal 6.0
  3.    and I only modified it a little  to demonstrate
  4.    features of my PRINTBGI library.
  5.    It is included here for demonstration only
  6.    and cannot be used for any other purposes. ( Could it? ).
  7.  
  8.    Original Copyright notice follows.
  9. }
  10.  
  11. { Turbo Graphics }
  12. { Copyright (c) 1985, 1990 by Borland International, Inc. }
  13.  
  14. program BGIDemo;
  15. (*
  16.   Turbo Pascal 6.0 Borland Graphics Interface (BGI) demonstration
  17.   program. This program shows how to use many features of
  18.   the Graph unit.
  19.  
  20.   NOTE: to have this demo use the IBM8514 driver, specify a
  21.   conditional define constant "Use8514" (using the {$DEFINE}
  22.   directive or Options\Compiler\Conditional defines) and then
  23.   re-compile.
  24.  
  25. *)
  26.  
  27. uses
  28.   Crt, Dos, Graph, PRTgraph,Pdrivers,UserUnit;
  29.  
  30.  
  31. const
  32.   { The five fonts available }
  33.   Fonts : array[0..4] of string[13] =
  34.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  35.  
  36.   { The five predefined line styles supported }
  37.   LineStyles : array[0..4] of string[9] =
  38.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  39.  
  40.   { The twelve predefined fill styles supported }
  41.   FillStyles : array[0..11] of string[14] =
  42.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  43.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  44.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  45.  
  46.   { The two text directions available }
  47.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  48.  
  49.   { The Horizontal text justifications available }
  50.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  51.  
  52.   { The vertical text justifications available }
  53.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  54.  
  55. var
  56.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  57.  
  58. var
  59.   GraphDriver : integer;  { The Graphics device driver }
  60.   GraphMode   : integer;  { The Graphics mode value }
  61.   (* MaxX, MaxY  : word;  *)   { The maximum resolution of the screen }
  62.       function MaxX:integer;
  63.       begin MaxX:=getmaxX; end;
  64.       function MaxY:integer;
  65.       begin MaxY:=getmaxY; end;
  66. var
  67.   ErrorCode   : integer;  { Reports any graphics errors }
  68.   (* MaxColor    : word;   *)  { The maximum color value available }
  69.       function MaxColor:integer;
  70.       begin MaxColor:=getmaxColor; end;
  71. var
  72.   OldExitProc : Pointer;  { Saves exit procedure address }
  73.  
  74. {$F+}
  75. procedure MyExitProc;
  76. var rc: integer;
  77. begin
  78.   ExitProc := OldExitProc; { Restore exit procedure address }
  79.   rc:=BGI_CloseGraph;              { Shut down the graphics system }
  80. end; { MyExitProc }
  81. {$F-}
  82.  
  83. VAR
  84.     PRTno:     word;
  85.     PRTmode:        integer;
  86.     OutName:    PathStr;
  87. Const
  88.     picwidth        : integer = 4000;
  89.     picheight     : integer =3000;
  90.     leftmargin     : integer =0;
  91.     topmargin     : integer =0;
  92.     PicRotate    : integer =0;
  93.     PicInverse    : integer =1;
  94.  
  95. {-------------------------------}
  96. Procedure ReadInt(var n: integer);
  97. {-------------------------------}
  98. var x: integer;
  99.      c: char;
  100. Begin
  101.     {$ifdef ver60 }
  102.         asm @@lp:;
  103.              mov  AH,1;   { nondestructive keyboard read }
  104.              int  $16;      { BIOS Kbd intr }
  105.              jz    @@lp;
  106.              mov  c,AL
  107.         end;
  108.         if c = ^M then
  109.         begin    (* user pressed ENTER - don't change old value *)
  110.             c := ReadKey;
  111.             writeln(n);
  112.         end
  113.         else
  114.     {$endif }
  115.     begin
  116.         {$I- }
  117.         ReadLn(x);
  118.         {$I+ }
  119.         if IOresult = 0 then n:=x;
  120.     end;
  121. End;
  122. (*-----------------------*)
  123. Procedure AskOfParameters;
  124. (*-----------------------*)
  125. var
  126.     c: char;
  127.     MAXmode    : integer;
  128.     modename        : stringPtr;
  129.     rc                : integer;
  130.     s:                PathStr;
  131. Begin
  132.     clrscr;
  133.     write ( ' Output device name [', OutName, '] ' );
  134.     ReadLn ( s ); if length(s)<>0 then OutName:=s;
  135.     rc := PRT_SetOutName ( OutName );
  136.     writeln;
  137.     writeln ( ' Choose printer mode operation' );
  138.     rc := PRT_MaxMode ( PRTno, MAXmode );
  139.     for PRTmode:=0 to MAXmode do
  140.     begin
  141.         {$V- }
  142.         rc := PRT_ModeName(PRTno,PRTmode,modename );
  143.         {$V+ }
  144.         writeln ( '        ', PRTmode:2,' - ', modename^ );
  145.     end;
  146.     PRTmode:=MAXmode+1;
  147.     repeat
  148.       c:=ReadKey;
  149.       if c=#0 then c:=ReadKey
  150.       else if ord(c)-ord('0') <= MAXmode then PRTmode := ord(c)-ord('0');
  151.     until  (PRTmode<=MAXmode) and (PRTmode>=0);
  152.  
  153.     writeln;
  154.     write ( ' Picture width in 1/1000 inch [', picwidth, '] ' );
  155.     ReadInt ( picwidth );
  156.     write ( ' Picture height in 1/1000 inch [', picheight, '] ' );
  157.     ReadInt ( picheight );
  158.  
  159.     write ( ' Top margin in 1/1000 inch [', topmargin, '] '  );
  160.     ReadInt ( topmargin );
  161.     write ( ' Left margin in 1/1000 inch [', leftmargin, '] ' );
  162.     ReadInt ( leftmargin );
  163.     write ( ' Rotate picture [', PicRotate, '] ' );
  164.     ReadInt ( PicRotate );
  165.     write ( ' Inverse picture [', PicInverse, '] ' );
  166.     ReadInt ( PicInverse );
  167.     write ( ' Screen Preview [', ScreenPreview, '] ' );
  168.     ReadInt ( ScreenPreview );
  169.     write ( ' PCX mode [', PCXmode, '] ' );
  170.     ReadInt ( PCXmode );
  171. End;
  172.  
  173. CONST
  174.     printing: boolean=false;
  175.     asking:     boolean=false;
  176. var
  177.     PRT_drv: integer;
  178.  
  179. (*---------------------------------*)
  180. Procedure DrawAndPrint ( func: DrawFuncT );
  181. (*---------------------------------*)
  182. const
  183.     Seed = 1964;
  184. var
  185.     rc  : integer;
  186.     BGIPRT_mode,mode: integer;
  187.     PicMode    : integer;
  188.     c: char;
  189.     opf: PRT_UserPrintFuncP;
  190.     imagePtr1,imagePtr2:    pointer;
  191.     s: string[7];
  192. Begin
  193.     BGIPRT_mode := 0;
  194.     repeat
  195.         asking:=false;
  196.       printing:=false;
  197.         RandSeed := Seed;
  198.         rc:=func(nil);
  199.         if asking then
  200.         begin
  201.             mode := BGI_getgraphmode(0,0);
  202.             restorecrtmode;
  203.             AskOfParameters;
  204.             BGI_setgraphmode( mode );
  205.         end;
  206.        if ( printing ) then   (* Have user pressed Ctrl-P ? *)
  207.        begin
  208.             Outmsg('Creating bit image map','Please wait',@imagePtr1);
  209.             RandSeed := Seed;
  210.             PicMode := 0;
  211.             if PicRotate<>0 then PicMode := PicMode or PRT_ROTATE;
  212.             if PicInverse<>0 then PicMode := PicMode or PRT_INVERSE;
  213.                 rc:=PRT_SetDriver ( PRTno, PRTmode,picwidth,picheight, PicMode );
  214.             rc:=PRT_SetMargins ( leftmargin, topmargin );
  215.             opf:=PRT_SetUserPrintFunc(PRT_ScreenPreview);
  216.             PRT_HaltPrinting := 0;      { reset ctrl-break flag }
  217.             rc:=PRT_PrintBGI ( PRT_drv, BGIPRT_mode, PathToDriver, func, nil );
  218.            if ( rc<>0 ) then
  219.            begin
  220.                 Str(rc:3,s);
  221.                 OutMsg (' error code '+s, PRT_errormsg(rc), @imagePtr2 );
  222.                 c:=ReadKey; while KeyPressed do c:=ReadKey;
  223.                 CloseOutMsg ( @imagePtr2 );
  224.             end;
  225.             CloseOutmsg( @imagePtr1);
  226.         end;
  227.     until ( not asking  and  not printing );
  228.  
  229. End;
  230.  
  231. (*-----------------*)
  232. Procedure  PRT_Initialize;
  233. (*-----------------*)
  234. var
  235.     PRTname:        stringPtr;
  236.     MaxPrinterNo: integer;
  237.     rc:            integer;
  238.     c:                char;
  239. Begin
  240.     OutName := 'PRN';
  241.     { rc:=PRT_LinkDrivers; }   { link printers definitions }
  242.     rc:=PRT_ReadDrivers(getenv('BGIPATH'),'Printers.Def');
  243.     if rc<>0 then
  244.     begin
  245.         writeln ('Sorry - I can''t find drivers defintion file' );
  246.         halt(12);
  247.     end;
  248.     MaxPrinterNo := PRT_MaxDriver;
  249.     clrscr;
  250.     writeln;
  251.     writeln ( 'This is a sample program (developed from Borland''s BGIDEMO.PAS)' );
  252.     writeln ( 'demonstrating some of the features of PrintBGI toolkit' );
  253.     writeln ( 'Hope you''ll find it usefull (the whole package not this program,' );
  254.     writeln ( 'of course).' );
  255.    writeln;
  256.    writeln ( 'Please, let me know if this program does not work with your printer.');
  257.    writeln ( 'To contact me write to RESZTAK@PLUMCS11.bitnet');
  258.     writeln;
  259.     writeln ( '              Press any key to continue');
  260.     c:=ReadKey; while KeyPressed do c:=ReadKey;
  261.     clrscr;
  262.  
  263.     writeln ( '    Choose printer type' );
  264.     writeln;
  265.     for PRTno:=1 to MaxPrinterNo do
  266.     begin
  267.         rc := PRT_DriverName(PRTno,PRTname);
  268.         writeln ( '        ', PRTno, ' - ', PRTname^ );
  269.     end;
  270.     repeat
  271.         Readln(PRTno);
  272.     until ( (PRTno<=MaxPrinterNo) and (PRTno>0) );
  273.  
  274.     clrscr;
  275.     PRT_drv := Detect; { needed if you don't want to link BitImage driver }
  276.     PRT_drv := PRT_installuserdriver ( 'BitImage', NIL );
  277.     rc := PRT_registerbgidriver ( @BitImage );
  278.  
  279.     AskOfParameters;
  280.     writeln;
  281.     writeln ( ' You will be able to change above parameters by pressing Ctrl-C.' );
  282.     writeln;
  283.     writeln ( '                   Press any key to continue');
  284.     c:=ReadKey;while KeyPressed do c:=ReadKey;
  285. End;
  286.  
  287.  
  288.  
  289. procedure Initialize;
  290. { Initialize graphics and report any errors that may occur }
  291. var
  292.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  293. begin
  294.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  295.   DirectVideo := False;
  296.   OldExitProc := ExitProc;                { save previous exit proc }
  297.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  298.   PathToDriver := getenv('BGIpath');
  299.   repeat
  300.  
  301. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  302.     GraphDriver := IBM8514;
  303.     GraphMode := IBM8514Hi;
  304. {$ELSE}
  305.     GraphDriver := Detect;                { use autodetection }
  306. {$ENDIF}
  307.  
  308.      ErrorCode:=BGI_InitGraph(GraphDriver, GraphMode, PathToDriver, Scrn_BGIgroup);
  309.      { ErrorCode := GraphResult; }         { preserve error return }
  310.     if ErrorCode <> grOK then             { error? }
  311.     begin
  312.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  313.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  314.       begin
  315.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  316.           Readln(PathToDriver);
  317.           Writeln;
  318.       end
  319.       else
  320.         Halt(1);                          { Some other error: terminate }
  321.     end;
  322.   until ErrorCode = grOK;
  323.   Randomize;                { init random number generator }
  324.   (************************************************************
  325.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  326.   MaxX := GetMaxX;          { Get screen resolution values }
  327.   MaxY := GetMaxY;
  328.   *************************************************************)
  329. end; { Initialize }
  330.  
  331. function Int2Str(L : LongInt) : string;
  332. { Converts an integer to a string for use with OutText, OutTextXY }
  333. var
  334.   S : string;
  335. begin
  336.   Str(L, S);
  337.   Int2Str := S;
  338. end; { Int2Str }
  339.  
  340. function RandColor : word;
  341. { Returns a Random non-zero color value that is within the legal
  342.   color range for the selected device driver and graphics mode.
  343.   MaxColor is set to GetMaxColor by Initialize }
  344. begin
  345.   RandColor := Random(MaxColor)+1;
  346. end; { RandColor }
  347.  
  348. procedure DefaultColors;
  349. { Select the maximum color in the Palette for the drawing color }
  350. begin
  351.   SetColor(MaxColor);
  352. end; { DefaultColors }
  353.  
  354. procedure DrawBorder;
  355. { Draw a border around the current view port }
  356. var
  357.   ViewPort : ViewPortType;
  358. begin
  359.   DefaultColors;
  360.   SetLineStyle(SolidLn, 0, NormWidth);
  361.   GetViewSettings(ViewPort);
  362.   with ViewPort do
  363.     Rectangle(0, 0, x2-x1, y2-y1);
  364. end; { DrawBorder }
  365.  
  366. procedure FullPort;
  367. { Set the view port to the entire screen }
  368. begin
  369.   SetViewPort(0, 0, MaxX, MaxY, ClipOn);
  370. end; { FullPort }
  371.  
  372. Procedure ChangeTextStyle(font, direction, charsize: integer);
  373. var
  374.   m:        integer;
  375.   x,y:    integer;
  376.   rc:        integer;
  377. Begin
  378.   rc := graphresult;        { clear error code }
  379.   if printing and (font=DEFAULTFONT)  then
  380.   begin
  381.         rc := PRT_Resolution ( x,y );
  382.         m := y+60 div 120;
  383.         if m > MaxX div 600+1 then m := MaxX div 600+1;
  384.         if m>1 then charsize :=charsize*m;
  385.   end;
  386.   settextstyle(font, direction, charsize);
  387. End; { ChangeTextStyle }
  388.  
  389.  
  390. procedure MainWindow(Header : string);
  391. { Make a default window and view port for demos }
  392. begin
  393.   DefaultColors;                           { Reset the colors }
  394.   ClearDevice;                             { Clear the screen }
  395.   ChangeTextStyle(DefaultFont, HorizDir, 1);  { Default text font }
  396.   SetTextJustify(CenterText, TopText);     { Left justify text }
  397.   FullPort;                                { Full screen view port }
  398.   OutTextXY(MaxX div 2, 2, Header);        { Draw the header }
  399.   { Draw main window }
  400.   SetViewPort(0, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn);
  401.   DrawBorder;                              { Put a border around it }
  402.   { Move the edges in 1 pixel on all sides so border isn't in the view port }
  403.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  404. end; { MainWindow }
  405.  
  406. procedure StatusLine(Msg : string);
  407. { Display a status line at the bottom of the screen }
  408. begin
  409.   FullPort;
  410.   DefaultColors;
  411.   ChangeTextStyle(DefaultFont, HorizDir, 1);
  412.   SetTextJustify(CenterText, TopText);
  413.   SetLineStyle(SolidLn, 0, NormWidth);
  414.   SetFillStyle(EmptyFill, 0);
  415.   Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);      { Erase old status line }
  416.   Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  417.   OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg);
  418.   { Go back to the main window }
  419.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  420. end; { StatusLine }
  421.  
  422. procedure WaitToGo;
  423. { Wait for the user to abort the program or continue }
  424. const
  425.   Esc = #27;
  426. var
  427.   Ch : char;
  428. begin
  429.   StatusLine('Esc aborts, Ctrl-P prints, other key continue');
  430.   if not printing then
  431.   begin
  432.       Ch := ReadKey;
  433.       case Ch of
  434.             Esc:  Halt(0);                           { terminate program }
  435.             ^P:   printing:=true;
  436.             ^C:   asking:=true;
  437.             else
  438.              ClearDevice;                      { clear screen, go on with demo }
  439.       end;
  440.       if ch = #0 then ch := readkey;      { trap function keys }
  441.   end;
  442. end; { WaitToGo }
  443.  
  444. procedure GetDriverAndMode(var DriveStr, ModeStr : string);
  445. { Return strings describing the current device driver and graphics mode
  446.   for display of status report }
  447. begin
  448.   DriveStr := GetDriverName;
  449.   ModeStr := GetModeName(BGI_GetGraphMode(0,0));
  450. end; { GetDriverAndMode }
  451.  
  452. {$F+ <-------------------------------- }
  453.  
  454. Function ReportStatus(UserPointer: pointer): integer;
  455. { Display the status of all query functions after InitGraph }
  456. const
  457.   X = 10;
  458. var
  459.   ViewInfo   : ViewPortType;     { Parameters for inquiry procedures }
  460.   LineInfo   : LineSettingsType;
  461.   FillInfo   : FillSettingsType;
  462.   TextInfo   : TextSettingsType;
  463.   Palette    : PaletteType;
  464.   DriverStr  : string;           { Driver and mode strings }
  465.   ModeStr    : string;
  466.   Y          : word;
  467.  
  468. procedure WriteOut(S : string);
  469. { Write out a string and increment to next line }
  470. begin
  471.   OutTextXY(X, Y, S);
  472.   Inc(Y, TextHeight('M')+2);
  473. end; { WriteOut }
  474.  
  475. begin { ReportStatus }
  476.   GetDriverAndMode(DriverStr, ModeStr);   { Get current settings }
  477.   GetViewSettings(ViewInfo);
  478.   GetLineSettings(LineInfo);
  479.   GetFillSettings(FillInfo);
  480.   GetTextSettings(TextInfo);
  481.   GetPalette(Palette);
  482.  
  483.   Y := 4;
  484.   MainWindow('Status report after InitGraph');
  485.   SetTextJustify(LeftText, TopText);
  486.   WriteOut('Graphics device    : '+DriverStr);
  487.   WriteOut('Graphics mode      : '+ModeStr);
  488.   WriteOut('Screen resolution  : (0, 0, '+Int2Str(GetMaxX)+', '+Int2Str(GetMaxY)+')');
  489.   with ViewInfo do
  490.   begin
  491.     WriteOut('Current view port  : ('+Int2Str(x1)+', '+Int2Str(y1)+', '+Int2Str(x2)+', '+Int2Str(y2)+')');
  492.     if ClipOn then
  493.       WriteOut('Clipping           : ON')
  494.     else
  495.       WriteOut('Clipping           : OFF');
  496.   end;
  497.   WriteOut('Current position   : ('+Int2Str(GetX)+', '+Int2Str(GetY)+')');
  498.   WriteOut('Palette entries    : '+Int2Str(Palette.Size));
  499.   WriteOut('GetMaxColor        : '+Int2Str(GetMaxColor));
  500.   WriteOut('Current color      : '+Int2Str(GetColor));
  501.   with LineInfo do
  502.   begin
  503.     WriteOut('Line style         : '+LineStyles[LineStyle]);
  504.     WriteOut('Line thickness     : '+Int2Str(Thickness));
  505.   end;
  506.   with FillInfo do
  507.   begin
  508.     WriteOut('Current fill style : '+FillStyles[Pattern]);
  509.     WriteOut('Current fill color : '+Int2Str(Color));
  510.   end;
  511.   with TextInfo do
  512.   begin
  513.     WriteOut('Current font       : '+Fonts[Font]);
  514.     WriteOut('Text direction     : '+TextDirect[Direction]);
  515.     WriteOut('Character size     : '+Int2Str(CharSize));
  516.     WriteOut('Horizontal justify : '+HorizJust[Horiz]);
  517.     WriteOut('Vertical justify   : '+VertJust[Vert]);
  518.   end;
  519.   WaitToGo;
  520.   ReportStatus := 0;
  521. end; { ReportStatus }
  522.  
  523. function FillEllipsePlay(UserPointer: pointer): integer;
  524. { Random filled ellipse demonstration }
  525. const
  526.   MaxFillStyles = 12; { patterns 0..11 }
  527. var
  528.   MaxRadius : word;
  529.   FillColor : integer;
  530.   _i            : integer;
  531. begin
  532.   MainWindow('FillEllipse Demostration');
  533.   { StatusLine('Esc aborts or press a key'); }
  534.   MaxRadius := MaxY div 10;
  535.   SetLineStyle(SolidLn, 0, NormWidth);
  536.   for _i:=1 to 40 do
  537.   begin
  538.      FillColor := RandColor;
  539.      SetColor(FillColor);
  540.      SetFillStyle(Random(MaxFillStyles), FillColor);
  541.      FillEllipse(Random(MaxX), Random(MaxY),
  542.                      Random(MaxRadius), Random(MaxRadius));
  543.   end;
  544.   WaitToGo;
  545.   FillEllipsePlay := 0;
  546. end; { FillEllipsePlay }
  547.  
  548. function SectorPlay(UserPointer: pointer): integer;
  549. { Draw random sectors on the screen }
  550. const
  551.   MaxFillStyles = 12; { patterns 0..11 }
  552. var
  553.   MaxRadius : word;
  554.   FillColor : integer;
  555.   EndAngle  : integer;
  556.   _i_            : integer;
  557. begin
  558.   MainWindow('Sector Demostration');
  559.   { StatusLine('Esc aborts or press a key'); }
  560.   MaxRadius := MaxY div 10;
  561.   SetLineStyle(SolidLn, 0, NormWidth);
  562.   for _i_:=1 to 40 do
  563.   begin
  564.      FillColor := RandColor;
  565.     SetColor(FillColor);
  566.     SetFillStyle(Random(MaxFillStyles), FillColor);
  567.     EndAngle := Random(360);
  568.     Sector(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle,
  569.            Random(MaxRadius), Random(MaxRadius));
  570.   end;
  571.   WaitToGo;
  572.   SectorPlay := 0;
  573. end; { SectorPlay }
  574.  
  575. function WriteModePlay(UserPointer: pointer): integer;
  576. { Demonstrate the SetWriteMode procedure for XOR lines }
  577. const
  578.   DelayValue = 50;  { milliseconds to delay }
  579. var
  580.   ViewInfo      : ViewPortType;
  581.   Color         : word;
  582.   Left, Top     : integer;
  583.   Right, Bottom : integer;
  584.   Step          : integer; { step for rectangle shrinking }
  585.   _i_                 : integer;
  586. begin
  587.   MainWindow('SetWriteMode Demostration');
  588.   { StatusLine('Esc aborts or press a key'); }
  589.   GetViewSettings(ViewInfo);
  590.   Left := 0;
  591.   Top := 0;
  592.   with ViewInfo do
  593.   begin
  594.     Right := x2-x1;
  595.     Bottom := y2-y1;
  596.   end;
  597.   Step := Bottom div 50;
  598.   SetColor(GetMaxColor);
  599.   Line(Left, Top, Right, Bottom);
  600.   Line(Left, Bottom, Right, Top);
  601.   SetWriteMode(XORPut);                    { Set XOR write mode }
  602.   for _i_:=1 to 50 do
  603.   begin
  604.      Line(Left, Top, Right, Bottom);        { Draw XOR lines }
  605.     Line(Left, Bottom, Right, Top);
  606.     Rectangle(Left, Top, Right, Bottom);   { Draw XOR rectangle }
  607.     Delay(DelayValue);                     { Wait }
  608.     Line(Left, Top, Right, Bottom);        { Erase lines }
  609.     Line(Left, Bottom, Right, Top);
  610.     Rectangle(Left, Top, Right, Bottom);   { Erase rectangle }
  611.     if (Left+Step < Right) and (Top+Step < Bottom) then
  612.       begin
  613.         Inc(Left, Step);                  { Shrink rectangle }
  614.         Inc(Top, Step);
  615.         Dec(Right, Step);
  616.         Dec(Bottom, Step);
  617.       end
  618.     else
  619.       begin
  620.         Color := RandColor;                { New color }
  621.         SetColor(Color);
  622.         Left := 0;                         { Original large rectangle }
  623.         Top := 0;
  624.         with ViewInfo do
  625.         begin
  626.           Right := x2-x1;
  627.           Bottom := y2-y1;
  628.         end;
  629.       end;
  630.   end;
  631.   SetWriteMode(CopyPut);                   { back to overwrite mode }
  632.   WaitToGo;
  633.   WriteModePlay := 0;
  634. end; { WriteModePlay }
  635.  
  636. function AspectRatioPlay(UserPointer: pointer): integer;
  637. { Demonstrate  SetAspectRatio command }
  638. var
  639.   ViewInfo   : ViewPortType;
  640.   CenterX    : integer;
  641.   CenterY    : integer;
  642.   Radius     : word;
  643.   Xasp, Yasp,
  644.   Xasp1, Yasp1: word;
  645.   i          : word;
  646.   RadiusStep : word;
  647. begin
  648.   MainWindow('SetAspectRatio Demostration');
  649.   GetViewSettings(ViewInfo);
  650.   with ViewInfo do
  651.   begin
  652.     CenterX := (x2-x1) div 2;
  653.     CenterY := (y2-y1) div 2;
  654.     Radius := 3*((y2-y1) div 5);
  655.   end;
  656.   RadiusStep := (Radius div 30);
  657.   Circle(CenterX, CenterY, Radius);
  658.   GetAspectRatio(Xasp1, Yasp1);
  659.   GetAspectRatio(Xasp, Yasp);
  660.   for i := 1 to 30 do
  661.   begin
  662.      if Yasp>$FFF0-getMaxX then begin Xasp:=Xasp div 2; Yasp:=Yasp div 2; end;
  663.      Inc(Yasp,GetMaxX);
  664.      SetAspectRatio(Xasp, Yasp);    { Increase Y aspect factor }
  665.      Circle(CenterX, CenterY, Radius);
  666.     if Radius > RadiusStep then
  667.         Dec(Radius, RadiusStep);                   { Shrink radius }
  668.   end;
  669.   Inc(Radius, RadiusStep*30);
  670.   Xasp:=Xasp1; Yasp:=Yasp1;
  671.   for i := 1 to 30 do
  672.   begin
  673.      if Xasp>$FFF0-getMaxX then begin Xasp:=Xasp div 2; Yasp:=Yasp div 2; end;
  674.      Inc(Xasp,GetMaxX);
  675.      SetAspectRatio(Xasp, Yasp);    { Increase X aspect factor }
  676.     if Radius > RadiusStep then
  677.       Dec(Radius, RadiusStep);                 { Shrink radius }
  678.     Circle(CenterX, CenterY, Radius);
  679.   end;
  680.   SetAspectRatio(Xasp1, Yasp1);                  { back to original aspect }
  681.   WaitToGo;
  682.   AspectRatioPlay := 0;
  683. end; { AspectRatioPlay }
  684.  
  685. function TextPlay(UserPointer: pointer): integer;
  686. { Demonstrate text justifications and text sizing }
  687. var
  688.   Size : word;
  689.   W, H, X, Y : word;
  690.   ViewInfo : ViewPortType;
  691. begin
  692.   MainWindow('SetTextJustify / SetUserCharSize demo');
  693.   GetViewSettings(ViewInfo);
  694.   with ViewInfo do
  695.   begin
  696.      ChangeTextStyle(TriplexFont, VertDir, 4);
  697.     Y := (y2-y1) - 2;
  698.     SetTextJustify(CenterText, BottomText);
  699.     OutTextXY(2*TextWidth('M'), Y, 'Vertical');
  700.      ChangeTextStyle(TriplexFont, HorizDir, 4);
  701.     SetTextJustify(LeftText, TopText);
  702.     OutTextXY(2*TextWidth('M'), 2, 'Horizontal');
  703.     SetTextJustify(CenterText, CenterText);
  704.     X := (x2-x1) div 2;
  705.     Y := TextHeight('H');
  706.     for Size := 1 to 4 do
  707.     begin
  708.         ChangeTextStyle(TriplexFont, HorizDir, Size);
  709.       H := TextHeight('M');
  710.       W := TextWidth('M');
  711.       Inc(Y, H);
  712.       OutTextXY(X, Y, 'Size '+Int2Str(Size));
  713.     end;
  714.     Inc(Y, H div 2);
  715.     SetTextJustify(CenterText, TopText);
  716.     SetUserCharSize(5, 6, 3, 2);
  717.      ChangeTextStyle(TriplexFont, HorizDir, UserCharSize);
  718.     OutTextXY((x2-x1) div 2, Y, 'User defined size!');
  719.   end;
  720.   WaitToGo;
  721.   TextPlay := 0;
  722. end; { TextPlay }
  723.  
  724. var
  725.   Font : word;
  726. function TextDump2(UserPointer: pointer): integer;
  727. { Dump the complete character sets to the screen }
  728. const
  729.   CGASizes  : array[0..4] of word = (1, 3, 7, 3, 3);
  730.   NormSizes : array[0..4] of word = (1, 4, 7, 4, 4);
  731. var
  732.   ViewInfo : ViewPortType;
  733.   Ch : char;
  734. begin
  735.      MainWindow(Fonts[Font]+' character set');
  736.     GetViewSettings(ViewInfo);
  737.     with ViewInfo do
  738.     begin
  739.       SetTextJustify(LeftText, TopText);
  740.       MoveTo(2, 3);
  741.       if Font = DefaultFont then
  742.         begin
  743.              ChangeTextStyle(Font, HorizDir, 1);
  744.           Ch := #0;
  745.           repeat
  746.             OutText(Ch);
  747.             if (GetX + TextWidth('M')) > (x2-x1) then
  748.               MoveTo(2, GetY + TextHeight('M')+3);
  749.             Ch := Succ(Ch);
  750.           until (Ch >= #255);
  751.         end
  752.       else
  753.         begin
  754.           if MaxY < 200 then
  755.                 ChangeTextStyle(Font, HorizDir, CGASizes[Font])
  756.           else
  757.                 ChangeTextStyle(Font, HorizDir, NormSizes[Font]);
  758.           Ch := '!';
  759.           repeat
  760.             OutText(Ch);
  761.             if (GetX + TextWidth('M')) > (x2-x1) then
  762.               MoveTo(2, GetY + TextHeight('M')+3);
  763.             Ch := Succ(Ch);
  764.           until (Ch >= #255);
  765.         end;
  766.     end; { with }
  767.      WaitToGo;
  768.      TextDump2 := 0;
  769. end; { TextDump2 }
  770.  
  771. procedure TextDump;
  772. { Dump the complete character sets to the screen }
  773. begin
  774.   for Font := 0 to 4 do
  775.   begin
  776.       DrawAndPrint(TextDump2);
  777.   end;
  778. end; {TextDump }
  779.  
  780. function LineToPlay(UserPointer: pointer): integer;
  781. { Demonstrate MoveTo and LineTo commands }
  782. const
  783.   MaxPoints = 15;
  784. var
  785.   Points     : array[0..MaxPoints] of PointType;
  786.   ViewInfo   : ViewPortType;
  787.   I, J       : integer;
  788.   CenterX    : integer;   { The center point of the circle }
  789.   CenterY    : integer;
  790.   Radius     : word;
  791.   StepAngle  : word;
  792.   Xasp, Yasp : word;
  793.   Radians    : real;
  794.  
  795. function AdjAsp(Value : integer) : integer;
  796. { Adjust a value for the aspect ratio of the device }
  797. begin
  798.   AdjAsp := (LongInt(Value) * Xasp) div Yasp;
  799. end; { AdjAsp }
  800.  
  801. begin
  802.   MainWindow('MoveTo, LineTo Demostration');
  803.   GetAspectRatio(Xasp, Yasp);
  804.   GetViewSettings(ViewInfo);
  805.   with ViewInfo do
  806.   begin
  807.     CenterX := (x2-x1) div 2;
  808.     CenterY := (y2-y1) div 2;
  809.     Radius := CenterY;
  810.     while (CenterY+AdjAsp(Radius)) < (y2-y1)-20 do
  811.       Inc(Radius);
  812.   end;
  813.   StepAngle := 360 div MaxPoints;
  814.   for I := 0 to MaxPoints - 1 do
  815.   begin
  816.     Radians := (StepAngle * I) * Pi / 180;
  817.     Points[I].X := CenterX + round(Cos(Radians) * Radius);
  818.     Points[I].Y := CenterY - AdjAsp(round(Sin(Radians) * Radius));
  819.   end;
  820.   Circle(CenterX, CenterY, Radius);
  821.   for I := 0 to MaxPoints - 1 do
  822.   begin
  823.     for J := I to MaxPoints - 1 do
  824.     begin
  825.       MoveTo(Points[I].X, Points[I].Y);
  826.       LineTo(Points[J].X, Points[J].Y);
  827.     end;
  828.   end;
  829.   WaitToGo;
  830.   LineToPlay :=0;
  831. end; { LineToPlay }
  832.  
  833. function LineRelPlay(UserPointer: pointer): integer;
  834. { Demonstrate MoveRel and LineRel commands }
  835. const
  836.   MaxPoints = 12;
  837. var
  838.   Poly     : array[1..MaxPoints] of PointType; { Stores a polygon for filling }
  839.   CurrPort : ViewPortType;
  840.  
  841. procedure DrawTesseract;
  842. { Draw a Tesseract on the screen with relative move and
  843.   line drawing commands, also create a polygon for filling }
  844. const
  845.   CheckerBoard : FillPatternType = (0, $10, $28, $44, $28, $10, 0, 0);
  846. var
  847.   X, Y, W, H   : integer;
  848.  
  849. begin
  850.   GetViewSettings(CurrPort);
  851.   with CurrPort do
  852.   begin
  853.     W := (x2-x1) div 9;
  854.     H := (y2-y1) div 8;
  855.     X := ((x2-x1) div 2) - round(2.5 * W);
  856.     Y := ((y2-y1) div 2) - (3 * H);
  857.  
  858.     { Border around viewport is outer part of polygon }
  859.     Poly[1].X := 0;     Poly[1].Y := 0;
  860.     Poly[2].X := x2-x1; Poly[2].Y := 0;
  861.     Poly[3].X := x2-x1; Poly[3].Y := y2-y1;
  862.     Poly[4].X := 0;     Poly[4].Y := y2-y1;
  863.     Poly[5].X := 0;     Poly[5].Y := 0;
  864.     MoveTo(X, Y);
  865.  
  866.     { Grab the whole in the polygon as we draw }
  867.     MoveRel(0, H);      Poly[6].X := GetX;  Poly[6].Y := GetY;
  868.     MoveRel(W, -H);     Poly[7].X := GetX;  Poly[7].Y := GetY;
  869.     MoveRel(4*W, 0);    Poly[8].X := GetX;  Poly[8].Y := GetY;
  870.     MoveRel(0, 5*H);    Poly[9].X := GetX;  Poly[9].Y := GetY;
  871.     MoveRel(-W, H);     Poly[10].X := GetX; Poly[10].Y := GetY;
  872.     MoveRel(-4*W, 0);   Poly[11].X := GetX; Poly[11].Y := GetY;
  873.     MoveRel(0, -5*H);   Poly[12].X := GetX; Poly[12].Y := GetY;
  874.  
  875.     { Fill the polygon with a user defined fill pattern }
  876.     SetFillPattern(CheckerBoard, MaxColor);
  877.     FillPoly(12, Poly);
  878.  
  879.     MoveRel(W, -H);
  880.     LineRel(0, 5*H);   LineRel(2*W, 0);    LineRel(0, -3*H);
  881.     LineRel(W, -H);    LineRel(0, 5*H);    MoveRel(0, -5*H);
  882.     LineRel(-2*W, 0);  LineRel(0, 3*H);    LineRel(-W, H);
  883.     MoveRel(W, -H);    LineRel(W, 0);      MoveRel(0, -2*H);
  884.     LineRel(-W, 0);
  885.  
  886.     { Flood fill the center }
  887.     FloodFill((x2-x1) div 2, (y2-y1) div 2, MaxColor);
  888.   end;
  889. end; { DrawTesseract }
  890.  
  891. begin
  892.   MainWindow('LineRel / MoveRel Demostration');
  893.   GetViewSettings(CurrPort);
  894.   with CurrPort do
  895.     { Move the viewport out 1 pixel from each end }
  896.     SetViewPort(x1-1, y1-1, x2+1, y2+1, ClipOn);
  897.   DrawTesseract;
  898.   WaitToGo;
  899.   LineRelPlay := 0;
  900. end; { LineRelPlay }
  901.  
  902. function PiePlay(UserPointer: pointer): integer;
  903. { Demonstrate  PieSlice and GetAspectRatio commands }
  904. var
  905.   ViewInfo   : ViewPortType;
  906.   CenterX    : integer;
  907.   CenterY    : integer;
  908.   Radius     : word;
  909.   Xasp, Yasp : word;
  910.   X, Y       : integer;
  911.  
  912. function AdjAsp(Value : integer) : integer;
  913. { Adjust a value for the aspect ratio of the device }
  914. begin
  915.   AdjAsp := (LongInt(Value) * Xasp) div Yasp;
  916. end; { AdjAsp }
  917.  
  918. procedure GetTextCoords(AngleInDegrees, Radius : word; var X, Y : integer);
  919. { Get the coordinates of text for pie slice labels }
  920. var
  921.   Radians : real;
  922. begin
  923.   Radians := AngleInDegrees * Pi / 180;
  924.   X := round(Cos(Radians) * Radius);
  925.   Y := round(Sin(Radians) * Radius);
  926. end; { GetTextCoords }
  927.  
  928. begin
  929.   MainWindow('PieSlice / GetAspectRatio Demostration');
  930.   GetAspectRatio(Xasp, Yasp);
  931.   GetViewSettings(ViewInfo);
  932.   with ViewInfo do
  933.   begin
  934.     CenterX := (x2-x1) div 2;
  935.     CenterY := ((y2-y1) div 2) + 20;
  936.     Radius := (y2-y1) div 3;
  937.     while AdjAsp(Radius) < round((y2-y1) / 3.6) do
  938.       Inc(Radius);
  939.   end;
  940.   ChangeTextStyle(TriplexFont, HorizDir, 4);
  941.   SetTextJustify(CenterText, TopText);
  942.   OutTextXY(CenterX, 0, 'This is a pie chart!');
  943.  
  944.   ChangeTextStyle(TriplexFont, HorizDir, 3);
  945.  
  946.   SetFillStyle(SolidFill, RandColor);
  947.   PieSlice(CenterX+10, CenterY-AdjAsp(10), 0, 90, Radius);
  948.   GetTextCoords(45, Radius, X, Y);
  949.   SetTextJustify(LeftText, BottomText);
  950.   OutTextXY(CenterX+10+X+TextWidth('H'), CenterY-AdjAsp(10+Y), '25 %');
  951.  
  952.   SetFillStyle(HatchFill, RandColor);
  953.   PieSlice(CenterX, CenterY, 225, 360, Radius);
  954.   GetTextCoords(293, Radius, X, Y);
  955.   SetTextJustify(LeftText, TopText);
  956.   OutTextXY(CenterX+X+TextWidth('H'), CenterY-AdjAsp(Y), '37.5 %');
  957.  
  958.   SetFillStyle(InterleaveFill, RandColor);
  959.   PieSlice(CenterX-10, CenterY, 135, 225, Radius);
  960.   GetTextCoords(180, Radius, X, Y);
  961.   SetTextJustify(RightText, CenterText);
  962.   OutTextXY(CenterX-10+X-TextWidth('H'), CenterY-AdjAsp(Y), '25 %');
  963.  
  964.   SetFillStyle(WideDotFill, RandColor);
  965.   PieSlice(CenterX, CenterY, 90, 135, Radius);
  966.   GetTextCoords(112, Radius, X, Y);
  967.   SetTextJustify(RightText, BottomText);
  968.   OutTextXY(CenterX+X-TextWidth('H'), CenterY-AdjAsp(Y), '12.5 %');
  969.  
  970.   WaitToGo;
  971.   PiePlay := 0;
  972. end; { PiePlay }
  973.  
  974. function Bar3DPlay(UserPointer: pointer): integer;
  975. { Demonstrate Bar3D command }
  976. const
  977.   NumBars   = 7;  { The number of bars drawn }
  978.   BarHeight : array[1..NumBars] of byte = (1, 3, 2, 5, 4, 2, 1);
  979.   YTicks    = 5;  { The number of tick marks on the Y axis }
  980. var
  981.   ViewInfo : ViewPortType;
  982.   H        : word;
  983.   XStep    : real;
  984.   YStep    : real;
  985.   I, J     : integer;
  986.   Depth    : word;
  987.   Color    : word;
  988. begin
  989.   MainWindow('Bar3D / Rectangle Demostration');
  990.   H := 3*TextHeight('M');
  991.   GetViewSettings(ViewInfo);
  992.   SetTextJustify(CenterText, TopText);
  993.   ChangeTextStyle(TriplexFont, HorizDir, 4);
  994.   OutTextXY(MaxX div 2, 6, 'These are 3D bars !');
  995.   ChangeTextStyle(DefaultFont, HorizDir, 1);
  996.   with ViewInfo do
  997.     SetViewPort(x1+50, y1+40, x2-50, y2-10, ClipOn);
  998.   GetViewSettings(ViewInfo);
  999.   with ViewInfo do
  1000.   begin
  1001.     Line(H, H, H, (y2-y1)-H);
  1002.     Line(H, (y2-y1)-H, (x2-x1)-H, (y2-y1)-H);
  1003.     YStep := ((y2-y1)-(2*H)) / YTicks;
  1004.     XStep := ((x2-x1)-(2*H)) / NumBars;
  1005.     J := (y2-y1)-H;
  1006.     SetTextJustify(CenterText, CenterText);
  1007.  
  1008.     { Draw the Y axis and ticks marks }
  1009.     for I := 0 to Yticks do
  1010.     begin
  1011.       Line(H div 2, J, H, J);
  1012.       OutTextXY(0, J, Int2Str(I));
  1013.       J := Round(J-Ystep);
  1014.     end;
  1015.  
  1016.  
  1017.     Depth := trunc(0.25 * XStep);    { Calculate depth of bar }
  1018.  
  1019.     { Draw X axis, bars, and tick marks }
  1020.     SetTextJustify(CenterText, TopText);
  1021.     J := H;
  1022.     for I := 1 to Succ(NumBars) do
  1023.     begin
  1024.       SetColor(MaxColor);
  1025.       Line(J, (y2-y1)-H, J, (y2-y1-3)-(H div 2));
  1026.       OutTextXY(J, (y2-y1)-(H div 2), Int2Str(I-1));
  1027.       if I <> Succ(NumBars) then
  1028.       begin
  1029.         Color := RandColor;
  1030.         SetFillStyle(I, Color);
  1031.         SetColor(Color);
  1032.         Bar3D(J, round((y2-y1-H)-(BarHeight[I] * Ystep)),
  1033.                  round(J+Xstep-Depth), round((y2-y1)-H-1), Depth, TopOn);
  1034.         J := Round(J+Xstep);
  1035.       end;
  1036.     end;
  1037.  
  1038.   end;
  1039.   WaitToGo;
  1040.   Bar3DPlay := 0;
  1041. end; { Bar3DPlay }
  1042.  
  1043. function BarPlay(UserPointer: pointer): integer;
  1044. { Demonstrate Bar command }
  1045. const
  1046.   NumBars   = 5;
  1047.   BarHeight : array[1..NumBars] of byte = (1, 3, 5, 2, 4);
  1048.   Styles    : array[1..NumBars] of byte = (1, 3, 10, 5, 9);
  1049. var
  1050.   ViewInfo  : ViewPortType;
  1051.   BarNum    : word;
  1052.   H         : word;
  1053.   XStep     : real;
  1054.   YStep     : real;
  1055.   I, J      : integer;
  1056.   Color     : word;
  1057. begin
  1058.   MainWindow('Bar / Rectangle Demostration');
  1059.   H := 3*TextHeight('M');
  1060.   GetViewSettings(ViewInfo);
  1061.   SetTextJustify(CenterText, TopText);
  1062.   ChangeTextStyle(TriplexFont, HorizDir, 4);
  1063.   OutTextXY(MaxX div 2, 6, 'These are 2D bars !');
  1064.   ChangeTextStyle(DefaultFont, HorizDir, 1);
  1065.   with ViewInfo do
  1066.     SetViewPort(x1+50, y1+30, x2-50, y2-10, ClipOn);
  1067.   GetViewSettings(ViewInfo);
  1068.   with ViewInfo do
  1069.   begin
  1070.     Line(H, H, H, (y2-y1)-H);
  1071.     Line(H, (y2-y1)-H, (x2-x1)-H, (y2-y1)-H);
  1072.     YStep := ((y2-y1)-(2*H)) / NumBars;
  1073.     XStep := ((x2-x1)-(2*H)) / NumBars;
  1074.     J := (y2-y1)-H;
  1075.     SetTextJustify(CenterText, CenterText);
  1076.  
  1077.     { Draw Y axis with tick marks }
  1078.     for I := 0 to NumBars do
  1079.     begin
  1080.       Line(H div 2, J, H, J);
  1081.       OutTextXY(0, J, Int2Str(i));
  1082.       J := Round(J-Ystep);
  1083.     end;
  1084.  
  1085.     { Draw X axis, bars, and tick marks }
  1086.     J := H;
  1087.     SetTextJustify(CenterText, TopText);
  1088.     for I := 1 to Succ(NumBars) do
  1089.     begin
  1090.       SetColor(MaxColor);
  1091.       Line(J, (y2-y1)-H, J, (y2-y1-3)-(H div 2));
  1092.       OutTextXY(J, (y2-y1)-(H div 2), Int2Str(I));
  1093.       if I <> Succ(NumBars) then
  1094.       begin
  1095.         Color := RandColor;
  1096.         SetFillStyle(Styles[I], Color);
  1097.         SetColor(Color);
  1098.         Bar(J, round((y2-y1-H)-(BarHeight[I] * Ystep)), round(J+Xstep), (y2-y1)-H-1);
  1099.         Rectangle(J, round((y2-y1-H)-(BarHeight[I] * Ystep)), round(J+Xstep), (y2-y1)-H-1);
  1100.       end;
  1101.       J := Round(J+Xstep);
  1102.     end;
  1103.  
  1104.   end;
  1105.   WaitToGo;
  1106.   BarPlay := 0;
  1107. end; { BarPlay }
  1108.  
  1109. function CirclePlay(UserPointer: pointer): integer;
  1110. { Draw random circles on the screen }
  1111. var
  1112.   MaxRadius : word;
  1113.   _i_            : integer;
  1114. begin
  1115.   MainWindow('Circle Demostration');
  1116.   { StatusLine('Esc aborts or press a key'); }
  1117.   MaxRadius := MaxY div 10;
  1118.   SetLineStyle(SolidLn, 0, NormWidth);
  1119.   for _i_:=1 to 50 do
  1120.   begin
  1121.      SetColor(RandColor);
  1122.      Circle(Random(MaxX), Random(MaxY), Random(MaxRadius));
  1123.   end;
  1124.   WaitToGo;
  1125.   CirclePlay := 0;
  1126. end; { CirclePlay }
  1127.  
  1128.  
  1129. function RandBarPlay(UserPointer: pointer): integer;
  1130. { Draw random bars on the screen }
  1131. var
  1132.   MaxWidth  : integer;
  1133.   MaxHeight : integer;
  1134.   ViewInfo  : ViewPortType;
  1135.   Color     : word;
  1136.   _i_            : integer;
  1137. begin
  1138.   MainWindow('Random Bars');
  1139.   { StatusLine('Esc aborts or press a key'); }
  1140.   GetViewSettings(ViewInfo);
  1141.   with ViewInfo do
  1142.   begin
  1143.     MaxWidth := x2-x1;
  1144.     MaxHeight := y2-y1;
  1145.   end;
  1146.   for _i_:=1 to 20 do
  1147.   begin
  1148.      Color := RandColor;
  1149.     SetColor(Color);
  1150.     SetFillStyle(Random(CloseDotFill)+1, Color);
  1151.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  1152.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  1153.   end;
  1154.   WaitToGo;
  1155.   RandBarPlay := 0;
  1156. end; { RandBarPlay }
  1157.  
  1158. function ArcPlay(UserPointer: pointer): integer;
  1159. { Draw random arcs on the screen }
  1160. var
  1161.   MaxRadius : word;
  1162.   EndAngle : word;
  1163.   ArcInfo : ArcCoordsType;
  1164.   _i_            : integer;
  1165. begin
  1166.   MainWindow('Arc / GetArcCoords Demostration');
  1167.   { StatusLine('Esc aborts or press a key'); }
  1168.   MaxRadius := MaxY div 10;
  1169.   for _i_:=1 to 50 do
  1170.   begin
  1171.      SetColor(RandColor);
  1172.     EndAngle := Random(360);
  1173.     SetLineStyle(SolidLn, 0, NormWidth);
  1174.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  1175.     GetArcCoords(ArcInfo);
  1176.     with ArcInfo do
  1177.     begin
  1178.       Line(X, Y, XStart, YStart);
  1179.       Line(X, Y, Xend, Yend);
  1180.     end;
  1181.   end;
  1182.   WaitToGo;
  1183.   ArcPlay := 0;
  1184. end; { ArcPlay }
  1185.  
  1186. function PutPixelPlay(UserPointer: pointer): integer;
  1187. { Demonstrate the PutPixel and GetPixel commands }
  1188. const
  1189.   Seed   = 1962; { A seed for the random number generator }
  1190.   NumPts = 2000; { The number of pixels plotted }
  1191.   Esc    = #27;
  1192. var
  1193.   I : word;
  1194.   X, Y, Color : word;
  1195.   XMax, YMax  : integer;
  1196.   ViewInfo    : ViewPortType;
  1197.   _i_        : integer;
  1198. begin
  1199.   MainWindow('PutPixel / GetPixel Demostration');
  1200.   { StatusLine('Esc aborts or press a key...'); }
  1201.  
  1202.   GetViewSettings(ViewInfo);
  1203.   with ViewInfo do
  1204.   begin
  1205.     XMax := (x2-x1-1);
  1206.     YMax := (y2-y1-1);
  1207.   end;
  1208.  
  1209.   { for _i_:=1 to 150 do }
  1210.   begin
  1211.      { Plot random pixels }
  1212.     RandSeed := Seed;
  1213.     I := 0;
  1214.     while (not KeyPressed) and (I < NumPts) do
  1215.     begin
  1216.       Inc(I);
  1217.       PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  1218.     end;
  1219.  
  1220.     { Erase pixels }
  1221.     RandSeed := Seed;
  1222.     I := 0;
  1223.     while (not KeyPressed) and (I < NumPts) do
  1224.     begin
  1225.       Inc(I);
  1226.       X := Random(XMax)+1;
  1227.       Y := Random(YMax)+1;
  1228.       Color := GetPixel(X, Y);
  1229.       if Color = RandColor then
  1230.         PutPixel(X, Y, 0);
  1231.     end;
  1232.   end;
  1233.   WaitToGo;
  1234.   PutPixelPlay := 0;
  1235. end; { PutPixelPlay }
  1236.  
  1237. function PutImagePlay(UserPointer: pointer): integer;
  1238. { Demonstrate the GetImage and PutImage commands }
  1239.  
  1240. const
  1241.   r  = 20;
  1242.   StartX = 100;
  1243.   StartY = 50;
  1244.  
  1245. var
  1246.   CurPort : ViewPortType;
  1247.  
  1248. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  1249. var
  1250.   Step : integer;
  1251. begin
  1252.   Step := Random(2*r);
  1253.   if Odd(Step) then
  1254.     Step := -Step;
  1255.   X := X + Step;
  1256.   Step := Random(r);
  1257.   if Odd(Step) then
  1258.     Step := -Step;
  1259.   Y := Y + Step;
  1260.  
  1261.   { Make saucer bounce off viewport walls }
  1262.   with CurPort do
  1263.   begin
  1264.     if (x1 + X + Width - 1 > x2) then
  1265.       X := x2-x1 - Width + 1
  1266.     else
  1267.       if (X < 0) then
  1268.         X := 0;
  1269.     if (y1 + Y + Height - 1 > y2) then
  1270.       Y := y2-y1 - Height + 1
  1271.     else
  1272.       if (Y < 0) then
  1273.         Y := 0;
  1274.   end;
  1275. end; { MoveSaucer }
  1276.  
  1277. var
  1278.   Pausetime : word;
  1279.   Saucer    : pointer;
  1280.   X, Y      : integer;
  1281.   ulx, uly  : word;
  1282.   lrx, lry  : word;
  1283.   Size      : word;
  1284.   I         : word;
  1285.   _i_            : integer;
  1286. begin
  1287.   ClearDevice;
  1288.   FullPort;
  1289.  
  1290.   { PaintScreen }
  1291.   ClearDevice;
  1292.   MainWindow('GetImage / PutImage Demonstration');
  1293.   { StatusLine('Esc aborts or press a key...'); }
  1294.   GetViewSettings(CurPort);
  1295.  
  1296.   { DrawSaucer }
  1297.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  1298.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  1299.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  1300.   Circle(StartX+10, StartY-12, 2);
  1301.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  1302.   Circle(StartX-10, StartY-12, 2);
  1303.   SetFillStyle(SolidFill, MaxColor);
  1304.   FloodFill(StartX+1, StartY+4, GetColor);
  1305.  
  1306.   { ReadSaucerImage }
  1307.   ulx := StartX-(r+1);
  1308.   uly := StartY-14;
  1309.   lrx := StartX+(r+1);
  1310.   lry := StartY+(r div 3)+3;
  1311.  
  1312.   Size := ImageSize(ulx, uly, lrx, lry);
  1313.   GetMem(Saucer, Size);
  1314.   GetImage(ulx, uly, lrx, lry, Saucer^);
  1315.   PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  1316.  
  1317.   { Plot some "stars" }
  1318.   for I := 1 to 1000 do
  1319.     PutPixel(Random(MaxX), Random(MaxY), RandColor);
  1320.   X := MaxX div 2;
  1321.   Y := MaxY div 2;
  1322.   PauseTime := 70;
  1323.  
  1324.   { Move the saucer around }
  1325.   for _i_:=1 to 30 do
  1326.   begin
  1327.      PutImage(X, Y, Saucer^, XORput);                 { draw image }
  1328.      Delay(PauseTime);
  1329.      PutImage(X, Y, Saucer^, XORput);                 { erase image }
  1330.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  1331.   end;
  1332.   FreeMem(Saucer, size);
  1333.   WaitToGo;
  1334.   PutImagePlay := 0;
  1335. end; { PutImagePlay }
  1336.  
  1337. function PolyPlay(UserPointer: pointer): integer;
  1338. { Draw random polygons with random fill styles on the screen }
  1339. const
  1340.   MaxPts = 5;
  1341. type
  1342.   PolygonType = array[1..MaxPts] of PointType;
  1343. var
  1344.   Poly : PolygonType;
  1345.   I, Color : word;
  1346.   _i_        : integer;
  1347. begin
  1348.   MainWindow('FillPoly Demostration');
  1349.   { StatusLine('Esc aborts or press a key...'); }
  1350.   for _i_:=1 to 20 do
  1351.   begin
  1352.      Color := RandColor;
  1353.     SetFillStyle(Random(11)+1, Color);
  1354.     SetColor(Color);
  1355.     for I := 1 to MaxPts do
  1356.       with Poly[I] do
  1357.       begin
  1358.         X := Random(MaxX);
  1359.         Y := Random(MaxY);
  1360.       end;
  1361.     FillPoly(MaxPts, Poly);
  1362.   end;
  1363.   WaitToGo;
  1364.   PolyPlay := 0;
  1365. end; { PolyPlay }
  1366.  
  1367. function FillStylePlay(UserPointer: pointer): integer;
  1368. { Display all of the predefined fill styles available }
  1369. var
  1370.   Style    : word;
  1371.   Width    : word;
  1372.   Height   : word;
  1373.   X, Y     : word;
  1374.   I, J     : word;
  1375.   ViewInfo : ViewPortType;
  1376.  
  1377. procedure DrawBox(X, Y : word);
  1378. begin
  1379.   SetFillStyle(Style, MaxColor);
  1380.   with ViewInfo do
  1381.     Bar(X, Y, X+Width, Y+Height);
  1382.   Rectangle(X, Y, X+Width, Y+Height);
  1383.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  1384.   Inc(Style);
  1385. end; { DrawBox }
  1386.  
  1387. begin
  1388.   MainWindow('Pre-defined fill styles');
  1389.   GetViewSettings(ViewInfo);
  1390.   with ViewInfo do
  1391.   begin
  1392.     Width := 2 * ((x2+1) div 13);
  1393.     Height := 2 * ((y2-10) div 10);
  1394.   end;
  1395.   X := Width div 2;
  1396.   Y := Height div 2;
  1397.   Style := 0;
  1398.   for J := 1 to 3 do
  1399.   begin
  1400.     for I := 1 to 4 do
  1401.     begin
  1402.       DrawBox(X, Y);
  1403.       Inc(X, (Width div 2) * 3);
  1404.     end;
  1405.     X := Width div 2;
  1406.     Inc(Y, (Height div 2) * 3);
  1407.   end;
  1408.   SetTextJustify(LeftText, TopText);
  1409.   WaitToGo;
  1410.   FillStylePlay := 0;
  1411. end; { FillStylePlay }
  1412.  
  1413. function FillPatternPlay(UserPointer: pointer): integer;
  1414. { Display some user defined fill patterns }
  1415. const
  1416.   Patterns : array[0..11] of FillPatternType = (
  1417.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55),
  1418.   ($33, $33, $CC, $CC, $33, $33, $CC, $CC),
  1419.   ($F0, $F0, $F0, $F0, $F, $F, $F, $F),
  1420.   (0, $10, $28, $44, $28, $10, 0, 0),
  1421.   (0, $70, $20, $27, $25, $27, $4, $4),
  1422.   (0, 0, 0, $18, $18, 0, 0, 0),
  1423.   (0, 0, $3C, $3C, $3C, $3C, 0, 0),
  1424.   (0, $7E, $7E, $7E, $7E, $7E, $7E, 0),
  1425.   (0, 0, $22, $8, 0, $22, $1C, 0),
  1426.   ($FF, $7E, $3C, $18, $18, $3C, $7E, $FF),
  1427.   (0, $10, $10, $7C, $10, $10, 0, 0),
  1428.   (0, $42, $24, $18, $18, $24, $42, 0));
  1429. var
  1430.   Style    : word;
  1431.   Width    : word;
  1432.   Height   : word;
  1433.   X, Y     : word;
  1434.   I, J     : word;
  1435.   ViewInfo : ViewPortType;
  1436.  
  1437. procedure DrawBox(X, Y : word);
  1438. begin
  1439.   SetFillPattern(Patterns[Style], MaxColor);
  1440.   with ViewInfo do
  1441.     Bar(X, Y, X+Width, Y+Height);
  1442.   Rectangle(X, Y, X+Width, Y+Height);
  1443.   Inc(Style);
  1444. end; { DrawBox }
  1445.  
  1446. begin
  1447.   MainWindow('User defined fill styles');
  1448.   GetViewSettings(ViewInfo);
  1449.   with ViewInfo do
  1450.   begin
  1451.     Width := 2 * ((x2+1) div 13);
  1452.     Height := 2 * ((y2-10) div 10);
  1453.   end;
  1454.   X := Width div 2;
  1455.   Y := Height div 2;
  1456.   Style := 0;
  1457.   for J := 1 to 3 do
  1458.   begin
  1459.     for I := 1 to 4 do
  1460.     begin
  1461.       DrawBox(X, Y);
  1462.       Inc(X, (Width div 2) * 3);
  1463.     end;
  1464.     X := Width div 2;
  1465.     Inc(Y, (Height div 2) * 3);
  1466.   end;
  1467.   SetTextJustify(LeftText, TopText);
  1468.   WaitToGo;
  1469.   FillPatternPlay := 0;
  1470. end; { FillPatternPlay }
  1471.  
  1472. function ColorPlay(UserPointer: pointer): integer;
  1473. { Display all of the colors available for the current driver and mode }
  1474. var
  1475.   Color    : word;
  1476.   Width    : word;
  1477.   Height   : word;
  1478.   X, Y     : word;
  1479.   I, J     : word;
  1480.   ViewInfo : ViewPortType;
  1481.  
  1482. procedure DrawBox(X, Y : word);
  1483. begin
  1484.   SetFillStyle(SolidFill, Color);
  1485.   SetColor(Color);
  1486.   with ViewInfo do
  1487.     Bar(X, Y, X+Width, Y+Height);
  1488.   Rectangle(X, Y, X+Width, Y+Height);
  1489.   Color := GetColor;
  1490.   if Color = 0 then
  1491.   begin
  1492.     SetColor(MaxColor);
  1493.     Rectangle(X, Y, X+Width, Y+Height);
  1494.   end;
  1495.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Color));
  1496.   Color := Succ(Color) mod (MaxColor + 1);
  1497. end; { DrawBox }
  1498.  
  1499. begin
  1500.   MainWindow('Color Demostration');
  1501.   Color := 1;
  1502.   GetViewSettings(ViewInfo);
  1503.   with ViewInfo do
  1504.   begin
  1505.     Width := 2 * ((x2+1) div 16);
  1506.     Height := 2 * ((y2-10) div 10);
  1507.   end;
  1508.   X := Width div 2;
  1509.   Y := Height div 2;
  1510.   for J := 1 to 3 do
  1511.   begin
  1512.     for I := 1 to 5 do
  1513.     begin
  1514.       DrawBox(X, Y);
  1515.       Inc(X, (Width div 2) * 3);
  1516.     end;
  1517.     X := Width div 2;
  1518.     Inc(Y, (Height div 2) * 3);
  1519.   end;
  1520.   WaitToGo;
  1521.   ColorPlay := 0;
  1522. end; { ColorPlay }
  1523.  
  1524. procedure PalettePlay;
  1525. { Demonstrate the use of the SetPalette command }
  1526. const
  1527.   XBars = 15;
  1528.   YBars = 10;
  1529. var
  1530.   I, J     : word;
  1531.   X, Y     : word;
  1532.   Color    : word;
  1533.   ViewInfo : ViewPortType;
  1534.   Width    : word;
  1535.   Height   : word;
  1536.   OldPal   : PaletteType;
  1537. begin
  1538.   GetPalette(OldPal);
  1539.   MainWindow('Palette Demostration');
  1540.   { StatusLine('Press any key...'); }
  1541.   GetViewSettings(ViewInfo);
  1542.   with ViewInfo do
  1543.   begin
  1544.     Width := (x2-x1) div XBars;
  1545.     Height := (y2-y1) div YBars;
  1546.   end;
  1547.   X := 0; Y := 0;
  1548.   Color := 0;
  1549.   for J := 1 to YBars do
  1550.   begin
  1551.     for I := 1 to XBars do
  1552.     begin
  1553.       SetFillStyle(SolidFill, Color);
  1554.       Bar(X, Y, X+Width, Y+Height);
  1555.       Inc(X, Width+1);
  1556.       Inc(Color);
  1557.       Color := Color mod (MaxColor+1);
  1558.     end;
  1559.     X := 0;
  1560.     Inc(Y, Height+1);
  1561.   end;
  1562.   repeat
  1563.     SetPalette(Random(GetMaxColor + 1), Random(65));
  1564.   until KeyPressed;
  1565.   SetAllPalette(OldPal);
  1566.   WaitToGo;
  1567. end; { PalettePlay }
  1568.  
  1569. procedure CrtModePlay;
  1570. { Demonstrate the use of RestoreCrtMode and SetGraphMode }
  1571. var
  1572.   ViewInfo : ViewPortType;
  1573.   Ch       : char;
  1574. begin
  1575.   MainWindow('SetGraphMode / RestoreCrtMode demo');
  1576.   GetViewSettings(ViewInfo);
  1577.   SetTextJustify(CenterText, CenterText);
  1578.   with ViewInfo do
  1579.   begin
  1580.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Now you are in graphics mode');
  1581.     StatusLine('Press any key for text mode...');
  1582.      Ch := ReadKey;
  1583.      if ch = #0 then ch := readkey;    { trap function keys }
  1584.     RestoreCrtmode;
  1585.     Writeln('Now you are in text mode.');
  1586.     Write('Press any key to go back to graphics...');
  1587.      Ch := ReadKey;
  1588.      if ch = #0 then ch := readkey;    { trap function keys }
  1589.      SetGraphMode(BGI_GetGraphMode(0,0));
  1590.     MainWindow('SetGraphMode / RestoreCrtMode demo');
  1591.     SetTextJustify(CenterText, CenterText);
  1592.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Back in graphics mode...');
  1593.   end;
  1594.   WaitToGo;
  1595. end; { CrtModePlay }
  1596.  
  1597. function LineStylePlay(UserPointer: pointer): integer;
  1598. { Demonstrate the predefined line styles available }
  1599. var
  1600.   Style    : word;
  1601.   Step     : word;
  1602.   X, Y     : word;
  1603.   ViewInfo : ViewPortType;
  1604.  
  1605. begin
  1606.   ClearDevice;
  1607.   DefaultColors;
  1608.   MainWindow('Pre-defined line styles');
  1609.   GetViewSettings(ViewInfo);
  1610.   with ViewInfo do
  1611.   begin
  1612.     X := 35;
  1613.     Y := 10;
  1614.     Step := (x2-x1) div 11;
  1615.     SetTextJustify(LeftText, TopText);
  1616.     OutTextXY(X, Y, 'NormWidth');
  1617.     SetTextJustify(CenterText, TopText);
  1618.     for Style := 0 to 3 do
  1619.     begin
  1620.       SetLineStyle(Style, 0, NormWidth);
  1621.       Line(X, Y+20, X, Y2-40);
  1622.       OutTextXY(X, Y2-30, Int2Str(Style));
  1623.       Inc(X, Step);
  1624.     end;
  1625.     Inc(X, 2*Step);
  1626.     SetTextJustify(LeftText, TopText);
  1627.     OutTextXY(X, Y, 'ThickWidth');
  1628.     SetTextJustify(CenterText, TopText);
  1629.     for Style := 0 to 3 do
  1630.     begin
  1631.       SetLineStyle(Style, 0, ThickWidth);
  1632.       Line(X, Y+20, X, Y2-40);
  1633.       OutTextXY(X, Y2-30, Int2Str(Style));
  1634.       Inc(X, Step);
  1635.     end;
  1636.   end;
  1637.   SetTextJustify(LeftText, TopText);
  1638.   WaitToGo;
  1639.   LineStylePlay := 0;
  1640. end; { LineStylePlay }
  1641.  
  1642. function UserLineStylePlay(UserPointer: pointer): integer;
  1643. { Demonstrate user defined line styles }
  1644. var
  1645.   Style    : word;
  1646.   X, Y, I  : word;
  1647.   ViewInfo : ViewPortType;
  1648. begin
  1649.   MainWindow('User defined line styles');
  1650.   GetViewSettings(ViewInfo);
  1651.   with ViewInfo do
  1652.   begin
  1653.     X := 4;
  1654.     Y := 10;
  1655.     Style := 0;
  1656.     I := 0;
  1657.     while X < X2-4 do
  1658.     begin
  1659.       {$B+}
  1660.       Style := Style or (1 shl (I mod 16));
  1661.       {$B-}
  1662.       SetLineStyle(UserBitLn, Style, NormWidth);
  1663.       Line(X, Y, X, (y2-y1)-Y);
  1664.       Inc(X, 5);
  1665.       Inc(I);
  1666.       if Style = 65535 then
  1667.       begin
  1668.         I := 0;
  1669.         Style := 0;
  1670.       end;
  1671.     end;
  1672.   end;
  1673.   WaitToGo;
  1674.   UserLineStylePlay := 0;
  1675. end; { UserLineStylePlay }
  1676.  
  1677.  
  1678. procedure SayGoodbye;
  1679. { Say goodbye and then exit the program }
  1680. var
  1681.   ViewInfo : ViewPortType;
  1682. begin
  1683.   MainWindow('');
  1684.   GetViewSettings(ViewInfo);
  1685.   ChangeTextStyle(TriplexFont, HorizDir, 4);
  1686.   SetTextJustify(CenterText, CenterText);
  1687.   with ViewInfo do
  1688.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  1689.   StatusLine('Press any key to quit...');
  1690.   repeat until KeyPressed;
  1691. end; { SayGoodbye }
  1692.  
  1693.  
  1694. {$F+ }
  1695. Procedure CtrlBreak_handler; interrupt;
  1696. Begin
  1697.     PRT_HaltPrinting := 1;
  1698. End;
  1699.  
  1700. var rc: integer;
  1701. begin { program body }
  1702.   PRT_Initialize;
  1703.   Initialize;
  1704.   SetIntVec($1b,Addr(CtrlBreak_handler)); { Ctrl-break handler is restored }
  1705.                                                  {    automaticely by DOS }
  1706.   DrawAndPrint(ReportStatus);
  1707.  
  1708.   DrawAndPrint(AspectRatioPlay);
  1709.   DrawAndPrint(FillEllipsePlay);
  1710.   DrawAndPrint(SectorPlay);
  1711.   DrawAndPrint(WriteModePlay);
  1712.  
  1713.   DrawAndPrint(ColorPlay);
  1714.   { PalettePlay only intended to work on these drivers: }
  1715.   if (GraphDriver = EGA) or
  1716.      (GraphDriver = EGA64) or
  1717.      (GraphDriver = VGA) then
  1718.     PalettePlay;
  1719.   DrawAndPrint(PutPixelPlay);
  1720.   DrawAndPrint(PutImagePlay);
  1721.   DrawAndPrint(RandBarPlay);
  1722.   DrawAndPrint(BarPlay);
  1723.   DrawAndPrint(Bar3DPlay);
  1724.   DrawAndPrint(ArcPlay);
  1725.   DrawAndPrint(CirclePlay);
  1726.   DrawAndPrint(PiePlay);
  1727.   DrawAndPrint(LineToPlay);
  1728.   DrawAndPrint(LineRelPlay);
  1729.   DrawAndPrint(LineStylePlay);
  1730.   DrawAndPrint(UserLineStylePlay);
  1731.   TextDump;
  1732.   DrawAndPrint(TextPlay);
  1733.   CrtModePlay;
  1734.   DrawAndPrint(FillStylePlay);
  1735.   DrawAndPrint(FillPatternPlay);
  1736.   DrawAndPrint(PolyPlay);
  1737.   SayGoodbye;
  1738.   rc:=BGI_CloseGraph;
  1739. end.
  1740.