home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo5 / bgidemo.pas < prev    next >
Pascal/Delphi Source File  |  1988-10-09  |  40KB  |  1,421 lines
  1.  
  2. { Copyright (c) 1985, 88 by Borland International, Inc. }
  3.  
  4. program BGIDemo;
  5. (*
  6.   Turbo Pascal 5.0 Borland Graphics Interface (BGI) demonstration
  7.   program. This program shows how to use many features of
  8.   the Graph unit.
  9.  
  10.   NOTE: to have this demo use the IBM8514 driver, specify a
  11.   conditional define constant "Use8514" (using the {$DEFINE}
  12.   directive or Options\Compiler\Conditional defines) and then
  13.   re-compile.
  14.  
  15. *)
  16.  
  17. uses
  18.   Crt, Dos, Graph;
  19.  
  20.  
  21. const
  22.   { The five fonts available }
  23.   Fonts : array[0..4] of string[13] =
  24.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  25.  
  26.   { The five predefined line styles supported }
  27.   LineStyles : array[0..4] of string[9] =
  28.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  29.  
  30.   { The twelve predefined fill styles supported }
  31.   FillStyles : array[0..11] of string[14] =
  32.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  33.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  34.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  35.  
  36.   { The two text directions available }
  37.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  38.  
  39.   { The Horizontal text justifications available }
  40.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  41.  
  42.   { The vertical text justifications available }
  43.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  44.  
  45. var
  46.   GraphDriver : integer;  { The Graphics device driver }
  47.   GraphMode   : integer;  { The Graphics mode value }
  48.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  49.   ErrorCode   : integer;  { Reports any graphics errors }
  50.   MaxColor    : word;     { The maximum color value available }
  51.   OldExitProc : Pointer;  { Saves exit procedure address }
  52.  
  53. {$F+}
  54. procedure MyExitProc;
  55. begin
  56.   ExitProc := OldExitProc; { Restore exit procedure address }
  57.   CloseGraph;              { Shut down the graphics system }
  58. end; { MyExitProc }
  59. {$F-}
  60.  
  61. procedure Initialize;
  62. { Initialize graphics and report any errors that may occur }
  63. var
  64.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  65.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  66. begin
  67.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  68.   DirectVideo := False;
  69.   OldExitProc := ExitProc;                { save previous exit proc }
  70.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  71.   PathToDriver := '';
  72.   repeat
  73.  
  74. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  75.     GraphDriver := IBM8514;
  76.     GraphMode := IBM8514Hi;
  77. {$ELSE}
  78.     GraphDriver := Detect;                { use autodetection }
  79. {$ENDIF}
  80.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  81.     ErrorCode := GraphResult;             { preserve error return }
  82.     if ErrorCode <> grOK then             { error? }
  83.     begin
  84.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  85.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  86.       begin
  87.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  88.         Readln(PathToDriver);
  89.         Writeln;
  90.       end
  91.       else
  92.         Halt(1);                          { Some other error: terminate }
  93.     end;
  94.   until ErrorCode = grOK;
  95.   Randomize;                { init random number generator }
  96.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  97.   MaxX := GetMaxX;          { Get screen resolution values }
  98.   MaxY := GetMaxY;
  99. end; { Initialize }
  100.  
  101. function Int2Str(L : LongInt) : string;
  102. { Converts an integer to a string for use with OutText, OutTextXY }
  103. var
  104.   S : string;
  105. begin
  106.   Str(L, S);
  107.   Int2Str := S;
  108. end; { Int2Str }
  109.  
  110. function RandColor : word;
  111. { Returns a Random non-zero color value that is within the legal
  112.   color range for the selected device driver and graphics mode.
  113.   MaxColor is set to GetMaxColor by Initialize }
  114. begin
  115.   RandColor := Random(MaxColor)+1;
  116. end; { RandColor }
  117.  
  118. procedure DefaultColors;
  119. { Select the maximum color in the Palette for the drawing color }
  120. begin
  121.   SetColor(MaxColor);
  122. end; { DefaultColors }
  123.  
  124. procedure DrawBorder;
  125. { Draw a border around the current view port }
  126. var
  127.   ViewPort : ViewPortType;
  128. begin
  129.   DefaultColors;
  130.   SetLineStyle(SolidLn, 0, NormWidth);
  131.   GetViewSettings(ViewPort);
  132.   with ViewPort do
  133.     Rectangle(0, 0, x2-x1, y2-y1);
  134. end; { DrawBorder }
  135.  
  136. procedure FullPort;
  137. { Set the view port to the entire screen }
  138. begin
  139.   SetViewPort(0, 0, MaxX, MaxY, ClipOn);
  140. end; { FullPort }
  141.  
  142. procedure MainWindow(Header : string);
  143. { Make a default window and view port for demos }
  144. begin
  145.   DefaultColors;                           { Reset the colors }
  146.   ClearDevice;                             { Clear the screen }
  147.   SetTextStyle(DefaultFont, HorizDir, 1);  { Default text font }
  148.   SetTextJustify(CenterText, TopText);     { Left justify text }
  149.   FullPort;                                { Full screen view port }
  150.   OutTextXY(MaxX div 2, 2, Header);        { Draw the header }
  151.   { Draw main window }
  152.   SetViewPort(0, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn);
  153.   DrawBorder;                              { Put a border around it }
  154.   { Move the edges in 1 pixel on all sides so border isn't in the view port }
  155.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  156. end; { MainWindow }
  157.  
  158. procedure StatusLine(Msg : string);
  159. { Display a status line at the bottom of the screen }
  160. begin
  161.   FullPort;
  162.   DefaultColors;
  163.   SetTextStyle(DefaultFont, HorizDir, 1);
  164.   SetTextJustify(CenterText, TopText);
  165.   SetLineStyle(SolidLn, 0, NormWidth);
  166.   SetFillStyle(EmptyFill, 0);
  167.   Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);      { Erase old status line }
  168.   Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  169.   OutTextXY(MaxX div 2, MaxY-(TextHeight('M')+2), Msg);
  170.   { Go back to the main window }
  171.   SetViewPort(1, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn);
  172. end; { StatusLine }
  173.  
  174. procedure WaitToGo;
  175. { Wait for the user to abort the program or continue }
  176. const
  177.   Esc = #27;
  178. var
  179.   Ch : char;
  180. begin
  181.   StatusLine('Esc aborts or press a key...');
  182.   repeat until KeyPressed;
  183.   Ch := ReadKey;
  184.   if ch = #0 then ch := readkey;      { trap function keys }
  185.   if Ch = Esc then
  186.     Halt(0)                           { terminate program }
  187.   else
  188.     ClearDevice;                      { clear screen, go on with demo }
  189. end; { WaitToGo }
  190.  
  191. procedure GetDriverAndMode(var DriveStr, ModeStr : string);
  192. { Return strings describing the current device driver and graphics mode
  193.   for display of status report }
  194. begin
  195.   DriveStr := GetDriverName;
  196.   ModeStr := GetModeName(GetGraphMode);
  197. end; { GetDriverAndMode }
  198.  
  199. procedure ReportStatus;
  200. { Display the status of all query functions after InitGraph }
  201. const
  202.   X = 10;
  203. var
  204.   ViewInfo   : ViewPortType;     { Parameters for inquiry procedures }
  205.   LineInfo   : LineSettingsType;
  206.   FillInfo   : FillSettingsType;
  207.   TextInfo   : TextSettingsType;
  208.   Palette    : PaletteType;
  209.   DriverStr  : string;           { Driver and mode strings }
  210.   ModeStr    : string;
  211.   Y          : word;
  212.  
  213. procedure WriteOut(S : string);
  214. { Write out a string and increment to next line }
  215. begin
  216.   OutTextXY(X, Y, S);
  217.   Inc(Y, TextHeight('M')+2);
  218. end; { WriteOut }
  219.  
  220. begin { ReportStatus }
  221.   GetDriverAndMode(DriverStr, ModeStr);   { Get current settings }
  222.   GetViewSettings(ViewInfo);
  223.   GetLineSettings(LineInfo);
  224.   GetFillSettings(FillInfo);
  225.   GetTextSettings(TextInfo);
  226.   GetPalette(Palette);
  227.  
  228.   Y := 4;
  229.   MainWindow('Status report after InitGraph');
  230.   SetTextJustify(LeftText, TopText);
  231.   WriteOut('Graphics device    : '+DriverStr);
  232.   WriteOut('Graphics mode      : '+ModeStr);
  233.   WriteOut('Screen resolution  : (0, 0, '+Int2Str(GetMaxX)+', '+Int2Str(GetMaxY)+')');
  234.   with ViewInfo do
  235.   begin
  236.     WriteOut('Current view port  : ('+Int2Str(x1)+', '+Int2Str(y1)+', '+Int2Str(x2)+', '+Int2Str(y2)+')');
  237.     if ClipOn then
  238.       WriteOut('Clipping           : ON')
  239.     else
  240.       WriteOut('Clipping           : OFF');
  241.   end;
  242.   WriteOut('Current position   : ('+Int2Str(GetX)+', '+Int2Str(GetY)+')');
  243.   WriteOut('Palette entries    : '+Int2Str(Palette.Size));
  244.   WriteOut('GetMaxColor        : '+Int2Str(GetMaxColor));
  245.   WriteOut('Current color      : '+Int2Str(GetColor));
  246.   with LineInfo do
  247.   begin
  248.     WriteOut('Line style         : '+LineStyles[LineStyle]);
  249.     WriteOut('Line thickness     : '+Int2Str(Thickness));
  250.   end;
  251.   with FillInfo do
  252.   begin
  253.     WriteOut('Current fill style : '+FillStyles[Pattern]);
  254.     WriteOut('Current fill color : '+Int2Str(Color));
  255.   end;
  256.   with TextInfo do
  257.   begin
  258.     WriteOut('Current font       : '+Fonts[Font]);
  259.     WriteOut('Text direction     : '+TextDirect[Direction]);
  260.     WriteOut('Character size     : '+Int2Str(CharSize));
  261.     WriteOut('Horizontal justify : '+HorizJust[Horiz]);
  262.     WriteOut('Vertical justify   : '+VertJust[Vert]);
  263.   end;
  264.   WaitToGo;
  265. end; { ReportStatus }
  266.  
  267. procedure FillEllipsePlay;
  268. { Random filled ellipse demonstration }
  269. const
  270.   MaxFillStyles = 12; { patterns 0..11 }
  271. var
  272.   MaxRadius : word;
  273.   FillColor : integer;
  274. begin
  275.   MainWindow('FillEllipse demonstration');
  276.   StatusLine('Esc aborts or press a key');
  277.   MaxRadius := MaxY div 10;
  278.   SetLineStyle(SolidLn, 0, NormWidth);
  279.   repeat
  280.     FillColor := RandColor;
  281.     SetColor(FillColor);
  282.     SetFillStyle(Random(MaxFillStyles), FillColor);
  283.     FillEllipse(Random(MaxX), Random(MaxY),
  284.                 Random(MaxRadius), Random(MaxRadius));
  285.   until KeyPressed;
  286.   WaitToGo;
  287. end; { FillEllipsePlay }
  288.  
  289. procedure SectorPlay;
  290. { Draw random sectors on the screen }
  291. const
  292.   MaxFillStyles = 12; { patterns 0..11 }
  293. var
  294.   MaxRadius : word;
  295.   FillColor : integer;
  296.   EndAngle  : integer;
  297. begin
  298.   MainWindow('Sector demonstration');
  299.   StatusLine('Esc aborts or press a key');
  300.   MaxRadius := MaxY div 10;
  301.   SetLineStyle(SolidLn, 0, NormWidth);
  302.   repeat
  303.     FillColor := RandColor;
  304.     SetColor(FillColor);
  305.     SetFillStyle(Random(MaxFillStyles), FillColor);
  306.     EndAngle := Random(360);
  307.     Sector(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle,
  308.            Random(MaxRadius), Random(MaxRadius));
  309.   until KeyPressed;
  310.   WaitToGo;
  311. end; { SectorPlay }
  312.  
  313. procedure WriteModePlay;
  314. { Demonstrate the SetWriteMode procedure for XOR lines }
  315. const
  316.   DelayValue = 50;  { milliseconds to delay }
  317. var
  318.   ViewInfo      : ViewPortType;
  319.   Color         : word;
  320.   Left, Top     : integer;
  321.   Right, Bottom : integer;
  322.   Step          : integer; { step for rectangle shrinking }
  323. begin
  324.   MainWindow('SetWriteMode demonstration');
  325.   StatusLine('Esc aborts or press a key');
  326.   GetViewSettings(ViewInfo);
  327.   Left := 0;
  328.   Top := 0;
  329.   with ViewInfo do
  330.   begin
  331.     Right := x2-x1;
  332.     Bottom := y2-y1;
  333.   end;
  334.   Step := Bottom div 50;
  335.   SetColor(GetMaxColor);
  336.   Line(Left, Top, Right, Bottom);
  337.   Line(Left, Bottom, Right, Top);
  338.   SetWriteMode(XORPut);                    { Set XOR write mode }
  339.   repeat
  340.     Line(Left, Top, Right, Bottom);        { Draw XOR lines }
  341.     Line(Left, Bottom, Right, Top);
  342.     Rectangle(Left, Top, Right, Bottom);   { Draw XOR rectangle }
  343.     Delay(DelayValue);                     { Wait }
  344.     Line(Left, Top, Right, Bottom);        { Erase lines }
  345.     Line(Left, Bottom, Right, Top);
  346.     Rectangle(Left, Top, Right, Bottom);   { Erase rectangle }
  347.     if (Left+Step < Right) and (Top+Step < Bottom) then
  348.       begin
  349.         Inc(Left, Step);                  { Shrink rectangle }
  350.         Inc(Top, Step);
  351.         Dec(Right, Step);
  352.         Dec(Bottom, Step);
  353.       end
  354.     else
  355.       begin
  356.         Color := RandColor;                { New color }
  357.         SetColor(Color);
  358.         Left := 0;                         { Original large rectangle }
  359.         Top := 0;
  360.         with ViewInfo do
  361.         begin
  362.           Right := x2-x1;
  363.           Bottom := y2-y1;
  364.         end;
  365.       end;
  366.   until KeyPressed;
  367.   SetWriteMode(CopyPut);                   { back to overwrite mode }
  368.   WaitToGo;
  369. end; { WriteModePlay }
  370.  
  371. procedure AspectRatioPlay;
  372. { Demonstrate  SetAspectRatio command }
  373. var
  374.   ViewInfo   : ViewPortType;
  375.   CenterX    : integer;
  376.   CenterY    : integer;
  377.   Radius     : word;
  378.   Xasp, Yasp : word;
  379.   i          : integer;
  380.   RadiusStep : word;
  381. begin
  382.   MainWindow('SetAspectRatio demonstration');
  383.   GetViewSettings(ViewInfo);
  384.   with ViewInfo do
  385.   begin
  386.     CenterX := (x2-x1) div 2;
  387.     CenterY := (y2-y1) div 2;
  388.     Radius := 3*((y2-y1) div 5);
  389.   end;
  390.   RadiusStep := (Radius div 30);
  391.   Circle(CenterX, CenterY, Radius);
  392.   GetAspectRatio(Xasp, Yasp);
  393.   for i := 1 to 30 do
  394.   begin
  395.     SetAspectRatio(Xasp, Yasp+(I*GetMaxX));    { Increase Y aspect factor }
  396.     Circle(CenterX, CenterY, Radius);
  397.     Dec(Radius, RadiusStep);                   { Shrink radius }
  398.   end;
  399.   Inc(Radius, RadiusStep*30);
  400.   for i := 1 to 30 do
  401.   begin
  402.     SetAspectRatio(Xasp+(I*GetMaxX), Yasp);    { Increase X aspect factor }
  403.     if Radius > RadiusStep then
  404.       Dec(Radius, RadiusStep);                 { Shrink radius }
  405.     Circle(CenterX, CenterY, Radius);
  406.   end;
  407.   SetAspectRatio(Xasp, Yasp);                  { back to original aspect }
  408.   WaitToGo;
  409. end; { AspectRatioPlay }
  410.  
  411. procedure TextPlay;
  412. { Demonstrate text justifications and text sizing }
  413. var
  414.   Size : word;
  415.   W, H, X, Y : word;
  416.   ViewInfo : ViewPortType;
  417. begin
  418.   MainWindow('SetTextJustify / SetUserCharSize demo');
  419.   GetViewSettings(ViewInfo);
  420.   with ViewInfo do
  421.   begin
  422.     SetTextStyle(TriplexFont, VertDir, 4);
  423.     Y := (y2-y1) - 2;
  424.     SetTextJustify(CenterText, BottomText);
  425.     OutTextXY(2*TextWidth('M'), Y, 'Vertical');
  426.     SetTextStyle(TriplexFont, HorizDir, 4);
  427.     SetTextJustify(LeftText, TopText);
  428.     OutTextXY(2*TextWidth('M'), 2, 'Horizontal');
  429.     SetTextJustify(CenterText, CenterText);
  430.     X := (x2-x1) div 2;
  431.     Y := TextHeight('H');
  432.     for Size := 1 to 4 do
  433.     begin
  434.       SetTextStyle(TriplexFont, HorizDir, Size);
  435.       H := TextHeight('M');
  436.       W := TextWidth('M');
  437.       Inc(Y, H);
  438.       OutTextXY(X, Y, 'Size '+Int2Str(Size));
  439.     end;
  440.     Inc(Y, H div 2);
  441.     SetTextJustify(CenterText, TopText);
  442.     SetUserCharSize(5, 6, 3, 2);
  443.     SetTextStyle(TriplexFont, HorizDir, UserCharSize);
  444.     OutTextXY((x2-x1) div 2, Y, 'User defined size!');
  445.   end;
  446.   WaitToGo;
  447. end; { TextPlay }
  448.  
  449. procedure TextDump;
  450. { Dump the complete character sets to the screen }
  451. const
  452.   CGASizes  : array[0..4] of word = (1, 3, 7, 3, 3);
  453.   NormSizes : array[0..4] of word = (1, 4, 7, 4, 4);
  454. var
  455.   Font : word;
  456.   ViewInfo : ViewPortType;
  457.   Ch : char;
  458. begin
  459.   for Font := 0 to 4 do
  460.   begin
  461.     MainWindow(Fonts[Font]+' character set');
  462.     GetViewSettings(ViewInfo);
  463.     with ViewInfo do
  464.     begin
  465.       SetTextJustify(LeftText, TopText);
  466.       MoveTo(2, 3);
  467.       if Font = DefaultFont then
  468.         begin
  469.           SetTextStyle(Font, HorizDir, 1);
  470.           Ch := #0;
  471.           repeat
  472.             OutText(Ch);
  473.             if (GetX + TextWidth('M')) > (x2-x1) then
  474.               MoveTo(2, GetY + TextHeight('M')+3);
  475.             Ch := Succ(Ch);
  476.           until (Ch >= #255);
  477.         end
  478.       else
  479.         begin
  480.           if MaxY < 200 then
  481.             SetTextStyle(Font, HorizDir, CGASizes[Font])
  482.           else
  483.             SetTextStyle(Font, HorizDir, NormSizes[Font]);
  484.           Ch := '!';
  485.           repeat
  486.             OutText(Ch);
  487.             if (GetX + TextWidth('M')) > (x2-x1) then
  488.               MoveTo(2, GetY + TextHeight('M')+3);
  489.             Ch := Succ(Ch);
  490.           until Ch = #255;
  491.         end;
  492.     end; { with }
  493.     WaitToGo;
  494.   end; { for loop }
  495. end; { TextDump }
  496.  
  497. procedure LineToPlay;
  498. { Demonstrate MoveTo and LineTo commands }
  499. const
  500.   MaxPoints = 15;
  501. var
  502.   Points     : array[0..MaxPoints] of PointType;
  503.   ViewInfo   : ViewPortType;
  504.   I, J       : integer;
  505.   CenterX    : integer;   { The center point of the circle }
  506.   CenterY    : integer;
  507.   Radius     : word;
  508.   StepAngle  : word;
  509.   Xasp, Yasp : word;
  510.   Radians    : real;
  511.  
  512. function AdjAsp(Value : integer) : integer;
  513. { Adjust a value for the aspect ratio of the device }
  514. begin
  515.   AdjAsp := (LongInt(Value) * Xasp) div Yasp;
  516. end; { AdjAsp }
  517.  
  518. begin
  519.   MainWindow('MoveTo, LineTo demonstration');
  520.   GetAspectRatio(Xasp, Yasp);
  521.   GetViewSettings(ViewInfo);
  522.   with ViewInfo do
  523.   begin
  524.     CenterX := (x2-x1) div 2;
  525.     CenterY := (y2-y1) div 2;
  526.     Radius := CenterY;
  527.     while (CenterY+AdjAsp(Radius)) < (y2-y1)-20 do
  528.       Inc(Radius);
  529.   end;
  530.   StepAngle := 360 div MaxPoints;
  531.   for I := 0 to MaxPoints - 1 do
  532.   begin
  533.     Radians := (StepAngle * I) * Pi / 180;
  534.     Points[I].X := CenterX + round(Cos(Radians) * Radius);
  535.     Points[I].Y := CenterY - AdjAsp(round(Sin(Radians) * Radius));
  536.   end;
  537.   Circle(CenterX, CenterY, Radius);
  538.   for I := 0 to MaxPoints - 1 do
  539.   begin
  540.     for J := I to MaxPoints - 1 do
  541.     begin
  542.       MoveTo(Points[I].X, Points[I].Y);
  543.       LineTo(Points[J].X, Points[J].Y);
  544.     end;
  545.   end;
  546.   WaitToGo;
  547. end; { LineToPlay }
  548.  
  549. procedure LineRelPlay;
  550. { Demonstrate MoveRel and LineRel commands }
  551. const
  552.   MaxPoints = 12;
  553. var
  554.   Poly     : array[1..MaxPoints] of PointType; { Stores a polygon for filling }
  555.   CurrPort : ViewPortType;
  556.  
  557. procedure DrawTesseract;
  558. { Draw a Tesseract on the screen with relative move and
  559.   line drawing commands, also create a polygon for filling }
  560. const
  561.   CheckerBoard : FillPatternType = (0, $10, $28, $44, $28, $10, 0, 0);
  562. var
  563.   X, Y, W, H   : integer;
  564.  
  565. begin
  566.   GetViewSettings(CurrPort);
  567.   with CurrPort do
  568.   begin
  569.     W := (x2-x1) div 9;
  570.     H := (y2-y1) div 8;
  571.     X := ((x2-x1) div 2) - round(2.5 * W);
  572.     Y := ((y2-y1) div 2) - (3 * H);
  573.  
  574.     { Border around viewport is outer part of polygon }
  575.     Poly[1].X := 0;     Poly[1].Y := 0;
  576.     Poly[2].X := x2-x1; Poly[2].Y := 0;
  577.     Poly[3].X := x2-x1; Poly[3].Y := y2-y1;
  578.     Poly[4].X := 0;     Poly[4].Y := y2-y1;
  579.     Poly[5].X := 0;     Poly[5].Y := 0;
  580.     MoveTo(X, Y);
  581.  
  582.     { Grab the whole in the polygon as we draw }
  583.     MoveRel(0, H);      Poly[6].X := GetX;  Poly[6].Y := GetY;
  584.     MoveRel(W, -H);     Poly[7].X := GetX;  Poly[7].Y := GetY;
  585.     MoveRel(4*W, 0);    Poly[8].X := GetX;  Poly[8].Y := GetY;
  586.     MoveRel(0, 5*H);    Poly[9].X := GetX;  Poly[9].Y := GetY;
  587.     MoveRel(-W, H);     Poly[10].X := GetX; Poly[10].Y := GetY;
  588.     MoveRel(-4*W, 0);   Poly[11].X := GetX; Poly[11].Y := GetY;
  589.     MoveRel(0, -5*H);   Poly[12].X := GetX; Poly[12].Y := GetY;
  590.  
  591.     { Fill the polygon with a user defined fill pattern }
  592.     SetFillPattern(CheckerBoard, MaxColor);
  593.     FillPoly(12, Poly);
  594.  
  595.     MoveRel(W, -H);
  596.     LineRel(0, 5*H);   LineRel(2*W, 0);    LineRel(0, -3*H);
  597.     LineRel(W, -H);    LineRel(0, 5*H);    MoveRel(0, -5*H);
  598.     LineRel(-2*W, 0);  LineRel(0, 3*H);    LineRel(-W, H);
  599.     MoveRel(W, -H);    LineRel(W, 0);      MoveRel(0, -2*H);
  600.     LineRel(-W, 0);
  601.  
  602.     { Flood fill the center }
  603.     FloodFill((x2-x1) div 2, (y2-y1) div 2, MaxColor);
  604.   end;
  605. end; { DrawTesseract }
  606.  
  607. begin
  608.   MainWindow('LineRel / MoveRel demonstration');
  609.   GetViewSettings(CurrPort);
  610.   with CurrPort do
  611.     { Move the viewport out 1 pixel from each end }
  612.     SetViewPort(x1-1, y1-1, x2+1, y2+1, ClipOn);
  613.   DrawTesseract;
  614.   WaitToGo;
  615. end; { LineRelPlay }
  616.  
  617. procedure PiePlay;
  618. { Demonstrate  PieSlice and GetAspectRatio commands }
  619. var
  620.   ViewInfo   : ViewPortType;
  621.   CenterX    : integer;
  622.   CenterY    : integer;
  623.   Radius     : word;
  624.   Xasp, Yasp : word;
  625.   X, Y       : integer;
  626.  
  627. function AdjAsp(Value : integer) : integer;
  628. { Adjust a value for the aspect ratio of the device }
  629. begin
  630.   AdjAsp := (LongInt(Value) * Xasp) div Yasp;
  631. end; { AdjAsp }
  632.  
  633. procedure GetTextCoords(AngleInDegrees, Radius : word; var X, Y : integer);
  634. { Get the coordinates of text for pie slice labels }
  635. var
  636.   Radians : real;
  637. begin
  638.   Radians := AngleInDegrees * Pi / 180;
  639.   X := round(Cos(Radians) * Radius);
  640.   Y := round(Sin(Radians) * Radius);
  641. end; { GetTextCoords }
  642.  
  643. begin
  644.   MainWindow('PieSlice / GetAspectRatio demonstration');
  645.   GetAspectRatio(Xasp, Yasp);
  646.   GetViewSettings(ViewInfo);
  647.   with ViewInfo do
  648.   begin
  649.     CenterX := (x2-x1) div 2;
  650.     CenterY := ((y2-y1) div 2) + 20;
  651.     Radius := (y2-y1) div 3;
  652.     while AdjAsp(Radius) < round((y2-y1) / 3.6) do
  653.       Inc(Radius);
  654.   end;
  655.   SetTextStyle(TriplexFont, HorizDir, 4);
  656.   SetTextJustify(CenterText, TopText);
  657.   OutTextXY(CenterX, 0, 'This is a pie chart!');
  658.  
  659.   SetTextStyle(TriplexFont, HorizDir, 3);
  660.  
  661.   SetFillStyle(SolidFill, RandColor);
  662.   PieSlice(CenterX+10, CenterY-AdjAsp(10), 0, 90, Radius);
  663.   GetTextCoords(45, Radius, X, Y);
  664.   SetTextJustify(LeftText, BottomText);
  665.   OutTextXY(CenterX+10+X+TextWidth('H'), CenterY-AdjAsp(10+Y), '25 %');
  666.  
  667.   SetFillStyle(HatchFill, RandColor);
  668.   PieSlice(CenterX, CenterY, 225, 360, Radius);
  669.   GetTextCoords(293, Radius, X, Y);
  670.   SetTextJustify(LeftText, TopText);
  671.   OutTextXY(CenterX+X+TextWidth('H'), CenterY-AdjAsp(Y), '37.5 %');
  672.  
  673.   SetFillStyle(InterleaveFill, RandColor);
  674.   PieSlice(CenterX-10, CenterY, 135, 225, Radius);
  675.   GetTextCoords(180, Radius, X, Y);
  676.   SetTextJustify(RightText, CenterText);
  677.   OutTextXY(CenterX-10+X-TextWidth('H'), CenterY-AdjAsp(Y), '25 %');
  678.  
  679.   SetFillStyle(WideDotFill, RandColor);
  680.   PieSlice(CenterX, CenterY, 90, 135, Radius);
  681.   GetTextCoords(112, Radius, X, Y);
  682.   SetTextJustify(RightText, BottomText);
  683.   OutTextXY(CenterX+X-TextWidth('H'), CenterY-AdjAsp(Y), '12.5 %');
  684.  
  685.   WaitToGo;
  686. end; { PiePlay }
  687.  
  688. procedure Bar3DPlay;
  689. { Demonstrate Bar3D command }
  690. const
  691.   NumBars   = 7;  { The number of bars drawn }
  692.   BarHeight : array[1..NumBars] of byte = (1, 3, 2, 5, 4, 2, 1);
  693.   YTicks    = 5;  { The number of tick marks on the Y axis }
  694. var
  695.   ViewInfo : ViewPortType;
  696.   H        : word;
  697.   XStep    : real;
  698.   YStep    : real;
  699.   I, J     : integer;
  700.   Depth    : word;
  701.   Color    : word;
  702. begin
  703.   MainWindow('Bar3D / Rectangle demonstration');
  704.   H := 3*TextHeight('M');
  705.   GetViewSettings(ViewInfo);
  706.   SetTextJustify(CenterText, TopText);
  707.   SetTextStyle(TriplexFont, HorizDir, 4);
  708.   OutTextXY(MaxX div 2, 6, 'These are 3D bars !');
  709.   SetTextStyle(DefaultFont, HorizDir, 1);
  710.   with ViewInfo do
  711.     SetViewPort(x1+50, y1+40, x2-50, y2-10, ClipOn);
  712.   GetViewSettings(ViewInfo);
  713.   with ViewInfo do
  714.   begin
  715.     Line(H, H, H, (y2-y1)-H);
  716.     Line(H, (y2-y1)-H, (x2-x1)-H, (y2-y1)-H);
  717.     YStep := ((y2-y1)-(2*H)) / YTicks;
  718.     XStep := ((x2-x1)-(2*H)) / NumBars;
  719.     J := (y2-y1)-H;
  720.     SetTextJustify(CenterText, CenterText);
  721.  
  722.     { Draw the Y axis and ticks marks }
  723.     for I := 0 to Yticks do
  724.     begin
  725.       Line(H div 2, J, H, J);
  726.       OutTextXY(0, J, Int2Str(I));
  727.       J := Round(J-Ystep);
  728.     end;
  729.  
  730.  
  731.     Depth := trunc(0.25 * XStep);    { Calculate depth of bar }
  732.  
  733.     { Draw X axis, bars, and tick marks }
  734.     SetTextJustify(CenterText, TopText);
  735.     J := H;
  736.     for I := 1 to Succ(NumBars) do
  737.     begin
  738.       SetColor(MaxColor);
  739.       Line(J, (y2-y1)-H, J, (y2-y1-3)-(H div 2));
  740.       OutTextXY(J, (y2-y1)-(H div 2), Int2Str(I-1));
  741.       if I <> Succ(NumBars) then
  742.       begin
  743.         Color := RandColor;
  744.         SetFillStyle(I, Color);
  745.         SetColor(Color);
  746.         Bar3D(J, round((y2-y1-H)-(BarHeight[I] * Ystep)),
  747.                  round(J+Xstep-Depth), round((y2-y1)-H-1), Depth, TopOn);
  748.         J := Round(J+Xstep);
  749.       end;
  750.     end;
  751.  
  752.   end;
  753.   WaitToGo;
  754. end; { Bar3DPlay }
  755.  
  756. procedure BarPlay;
  757. { Demonstrate Bar command }
  758. const
  759.   NumBars   = 5;
  760.   BarHeight : array[1..NumBars] of byte = (1, 3, 5, 2, 4);
  761.   Styles    : array[1..NumBars] of byte = (1, 3, 10, 5, 9);
  762. var
  763.   ViewInfo  : ViewPortType;
  764.   BarNum    : word;
  765.   H         : word;
  766.   XStep     : real;
  767.   YStep     : real;
  768.   I, J      : integer;
  769.   Color     : word;
  770. begin
  771.   MainWindow('Bar / Rectangle demonstration');
  772.   H := 3*TextHeight('M');
  773.   GetViewSettings(ViewInfo);
  774.   SetTextJustify(CenterText, TopText);
  775.   SetTextStyle(TriplexFont, HorizDir, 4);
  776.   OutTextXY(MaxX div 2, 6, 'These are 2D bars !');
  777.   SetTextStyle(DefaultFont, HorizDir, 1);
  778.   with ViewInfo do
  779.     SetViewPort(x1+50, y1+30, x2-50, y2-10, ClipOn);
  780.   GetViewSettings(ViewInfo);
  781.   with ViewInfo do
  782.   begin
  783.     Line(H, H, H, (y2-y1)-H);
  784.     Line(H, (y2-y1)-H, (x2-x1)-H, (y2-y1)-H);
  785.     YStep := ((y2-y1)-(2*H)) / NumBars;
  786.     XStep := ((x2-x1)-(2*H)) / NumBars;
  787.     J := (y2-y1)-H;
  788.     SetTextJustify(CenterText, CenterText);
  789.  
  790.     { Draw Y axis with tick marks }
  791.     for I := 0 to NumBars do
  792.     begin
  793.       Line(H div 2, J, H, J);
  794.       OutTextXY(0, J, Int2Str(i));
  795.       J := Round(J-Ystep);
  796.     end;
  797.  
  798.     { Draw X axis, bars, and tick marks }
  799.     J := H;
  800.     SetTextJustify(CenterText, TopText);
  801.     for I := 1 to Succ(NumBars) do
  802.     begin
  803.       SetColor(MaxColor);
  804.       Line(J, (y2-y1)-H, J, (y2-y1-3)-(H div 2));
  805.       OutTextXY(J, (y2-y1)-(H div 2), Int2Str(I));
  806.       if I <> Succ(NumBars) then
  807.       begin
  808.         Color := RandColor;
  809.         SetFillStyle(Styles[I], Color);
  810.         SetColor(Color);
  811.         Bar(J, round((y2-y1-H)-(BarHeight[I] * Ystep)), round(J+Xstep), (y2-y1)-H-1);
  812.         Rectangle(J, round((y2-y1-H)-(BarHeight[I] * Ystep)), round(J+Xstep), (y2-y1)-H-1);
  813.       end;
  814.       J := Round(J+Xstep);
  815.     end;
  816.  
  817.   end;
  818.   WaitToGo;
  819. end; { BarPlay }
  820.  
  821. procedure CirclePlay;
  822. { Draw random circles on the screen }
  823. var
  824.   MaxRadius : word;
  825. begin
  826.   MainWindow('Circle demonstration');
  827.   StatusLine('Esc aborts or press a key');
  828.   MaxRadius := MaxY div 10;
  829.   SetLineStyle(SolidLn, 0, NormWidth);
  830.   repeat
  831.     SetColor(RandColor);
  832.     Circle(Random(MaxX), Random(MaxY), Random(MaxRadius));
  833.   until KeyPressed;
  834.   WaitToGo;
  835. end; { CirclePlay }
  836.  
  837.  
  838. procedure RandBarPlay;
  839. { Draw random bars on the screen }
  840. var
  841.   MaxWidth  : integer;
  842.   MaxHeight : integer;
  843.   ViewInfo  : ViewPortType;
  844.   Color     : word;
  845. begin
  846.   MainWindow('Random Bars');
  847.   StatusLine('Esc aborts or press a key');
  848.   GetViewSettings(ViewInfo);
  849.   with ViewInfo do
  850.   begin
  851.     MaxWidth := x2-x1;
  852.     MaxHeight := y2-y1;
  853.   end;
  854.   repeat
  855.     Color := RandColor;
  856.     SetColor(Color);
  857.     SetFillStyle(Random(CloseDotFill)+1, Color);
  858.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  859.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  860.   until KeyPressed;
  861.   WaitToGo;
  862. end; { RandBarPlay }
  863.  
  864. procedure ArcPlay;
  865. { Draw random arcs on the screen }
  866. var
  867.   MaxRadius : word;
  868.   EndAngle : word;
  869.   ArcInfo : ArcCoordsType;
  870. begin
  871.   MainWindow('Arc / GetArcCoords demonstration');
  872.   StatusLine('Esc aborts or press a key');
  873.   MaxRadius := MaxY div 10;
  874.   repeat
  875.     SetColor(RandColor);
  876.     EndAngle := Random(360);
  877.     SetLineStyle(SolidLn, 0, NormWidth);
  878.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  879.     GetArcCoords(ArcInfo);
  880.     with ArcInfo do
  881.     begin
  882.       Line(X, Y, XStart, YStart);
  883.       Line(X, Y, Xend, Yend);
  884.     end;
  885.   until KeyPressed;
  886.   WaitToGo;
  887. end; { ArcPlay }
  888.  
  889. procedure PutPixelPlay;
  890. { Demonstrate the PutPixel and GetPixel commands }
  891. const
  892.   Seed   = 1962; { A seed for the random number generator }
  893.   NumPts = 2000; { The number of pixels plotted }
  894.   Esc    = #27;
  895. var
  896.   I : word;
  897.   X, Y, Color : word;
  898.   XMax, YMax  : integer;
  899.   ViewInfo    : ViewPortType;
  900. begin
  901.   MainWindow('PutPixel / GetPixel demonstration');
  902.   StatusLine('Esc aborts or press a key...');
  903.  
  904.   GetViewSettings(ViewInfo);
  905.   with ViewInfo do
  906.   begin
  907.     XMax := (x2-x1-1);
  908.     YMax := (y2-y1-1);
  909.   end;
  910.  
  911.   while not KeyPressed do
  912.   begin
  913.     { Plot random pixels }
  914.     RandSeed := Seed;
  915.     I := 0;
  916.     while (not KeyPressed) and (I < NumPts) do
  917.     begin
  918.       Inc(I);
  919.       PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  920.     end;
  921.  
  922.     { Erase pixels }
  923.     RandSeed := Seed;
  924.     I := 0;
  925.     while (not KeyPressed) and (I < NumPts) do
  926.     begin
  927.       Inc(I);
  928.       X := Random(XMax)+1;
  929.       Y := Random(YMax)+1;
  930.       Color := GetPixel(X, Y);
  931.       if Color = RandColor then
  932.         PutPixel(X, Y, 0);
  933.     end;
  934.   end;
  935.   WaitToGo;
  936. end; { PutPixelPlay }
  937.  
  938. procedure PutImagePlay;
  939. { Demonstrate the GetImage and PutImage commands }
  940.  
  941. const
  942.   r  = 20;
  943.   StartX = 100;
  944.   StartY = 50;
  945.  
  946. var
  947.   CurPort : ViewPortType;
  948.  
  949. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  950. var
  951.   Step : integer;
  952. begin
  953.   Step := Random(2*r);
  954.   if Odd(Step) then
  955.     Step := -Step;
  956.   X := X + Step;
  957.   Step := Random(r);
  958.   if Odd(Step) then
  959.     Step := -Step;
  960.   Y := Y + Step;
  961.  
  962.   { Make saucer bounce off viewport walls }
  963.   with CurPort do
  964.   begin
  965.     if (x1 + X + Width - 1 > x2) then
  966.       X := x2-x1 - Width + 1
  967.     else
  968.       if (X < 0) then
  969.         X := 0;
  970.     if (y1 + Y + Height - 1 > y2) then
  971.       Y := y2-y1 - Height + 1
  972.     else
  973.       if (Y < 0) then
  974.         Y := 0;
  975.   end;
  976. end; { MoveSaucer }
  977.  
  978. var
  979.   Pausetime : word;
  980.   Saucer    : pointer;
  981.   X, Y      : integer;
  982.   ulx, uly  : word;
  983.   lrx, lry  : word;
  984.   Size      : word;
  985.   I         : word;
  986. begin
  987.   ClearDevice;
  988.   FullPort;
  989.  
  990.   { PaintScreen }
  991.   ClearDevice;
  992.   MainWindow('GetImage / PutImage Demonstration');
  993.   StatusLine('Esc aborts or press a key...');
  994.   GetViewSettings(CurPort);
  995.  
  996.   { DrawSaucer }
  997.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  998.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  999.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  1000.   Circle(StartX+10, StartY-12, 2);
  1001.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  1002.   Circle(StartX-10, StartY-12, 2);
  1003.   SetFillStyle(SolidFill, MaxColor);
  1004.   FloodFill(StartX+1, StartY+4, GetColor);
  1005.  
  1006.   { ReadSaucerImage }
  1007.   ulx := StartX-(r+1);
  1008.   uly := StartY-14;
  1009.   lrx := StartX+(r+1);
  1010.   lry := StartY+(r div 3)+3;
  1011.  
  1012.   Size := ImageSize(ulx, uly, lrx, lry);
  1013.   GetMem(Saucer, Size);
  1014.   GetImage(ulx, uly, lrx, lry, Saucer^);
  1015.   PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  1016.  
  1017.   { Plot some "stars" }
  1018.   for I := 1 to 1000 do
  1019.     PutPixel(Random(MaxX), Random(MaxY), RandColor);
  1020.   X := MaxX div 2;
  1021.   Y := MaxY div 2;
  1022.   PauseTime := 70;
  1023.  
  1024.   { Move the saucer around }
  1025.   repeat
  1026.     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  1027.     Delay(PauseTime);
  1028.     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  1029.     MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  1030.   until KeyPressed;
  1031.   FreeMem(Saucer, size);
  1032.   WaitToGo;
  1033. end; { PutImagePlay }
  1034.  
  1035. procedure PolyPlay;
  1036. { Draw random polygons with random fill styles on the screen }
  1037. const
  1038.   MaxPts = 5;
  1039. type
  1040.   PolygonType = array[1..MaxPts] of PointType;
  1041. var
  1042.   Poly : PolygonType;
  1043.   I, Color : word;
  1044. begin
  1045.   MainWindow('FillPoly demonstration');
  1046.   StatusLine('Esc aborts or press a key...');
  1047.   repeat
  1048.     Color := RandColor;
  1049.     SetFillStyle(Random(11)+1, Color);
  1050.     SetColor(Color);
  1051.     for I := 1 to MaxPts do
  1052.       with Poly[I] do
  1053.       begin
  1054.         X := Random(MaxX);
  1055.         Y := Random(MaxY);
  1056.       end;
  1057.     FillPoly(MaxPts, Poly);
  1058.   until KeyPressed;
  1059.   WaitToGo;
  1060. end; { PolyPlay }
  1061.  
  1062. procedure FillStylePlay;
  1063. { Display all of the predefined fill styles available }
  1064. var
  1065.   Style    : word;
  1066.   Width    : word;
  1067.   Height   : word;
  1068.   X, Y     : word;
  1069.   I, J     : word;
  1070.   ViewInfo : ViewPortType;
  1071.  
  1072. procedure DrawBox(X, Y : word);
  1073. begin
  1074.   SetFillStyle(Style, MaxColor);
  1075.   with ViewInfo do
  1076.     Bar(X, Y, X+Width, Y+Height);
  1077.   Rectangle(X, Y, X+Width, Y+Height);
  1078.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  1079.   Inc(Style);
  1080. end; { DrawBox }
  1081.  
  1082. begin
  1083.   MainWindow('Pre-defined fill styles');
  1084.   GetViewSettings(ViewInfo);
  1085.   with ViewInfo do
  1086.   begin
  1087.     Width := 2 * ((x2+1) div 13);
  1088.     Height := 2 * ((y2-10) div 10);
  1089.   end;
  1090.   X := Width div 2;
  1091.   Y := Height div 2;
  1092.   Style := 0;
  1093.   for J := 1 to 3 do
  1094.   begin
  1095.     for I := 1 to 4 do
  1096.     begin
  1097.       DrawBox(X, Y);
  1098.       Inc(X, (Width div 2) * 3);
  1099.     end;
  1100.     X := Width div 2;
  1101.     Inc(Y, (Height div 2) * 3);
  1102.   end;
  1103.   SetTextJustify(LeftText, TopText);
  1104.   WaitToGo;
  1105. end; { FillStylePlay }
  1106.  
  1107. procedure FillPatternPlay;
  1108. { Display some user defined fill patterns }
  1109. const
  1110.   Patterns : array[0..11] of FillPatternType = (
  1111.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55),
  1112.   ($33, $33, $CC, $CC, $33, $33, $CC, $CC),
  1113.   ($F0, $F0, $F0, $F0, $F, $F, $F, $F),
  1114.   (0, $10, $28, $44, $28, $10, 0, 0),
  1115.   (0, $70, $20, $27, $25, $27, $4, $4),
  1116.   (0, 0, 0, $18, $18, 0, 0, 0),
  1117.   (0, 0, $3C, $3C, $3C, $3C, 0, 0),
  1118.   (0, $7E, $7E, $7E, $7E, $7E, $7E, 0),
  1119.   (0, 0, $22, $8, 0, $22, $1C, 0),
  1120.   ($FF, $7E, $3C, $18, $18, $3C, $7E, $FF),
  1121.   (0, $10, $10, $7C, $10, $10, 0, 0),
  1122.   (0, $42, $24, $18, $18, $24, $42, 0));
  1123. var
  1124.   Style    : word;
  1125.   Width    : word;
  1126.   Height   : word;
  1127.   X, Y     : word;
  1128.   I, J     : word;
  1129.   ViewInfo : ViewPortType;
  1130.  
  1131. procedure DrawBox(X, Y : word);
  1132. begin
  1133.   SetFillPattern(Patterns[Style], MaxColor);
  1134.   with ViewInfo do
  1135.     Bar(X, Y, X+Width, Y+Height);
  1136.   Rectangle(X, Y, X+Width, Y+Height);
  1137.   Inc(Style);
  1138. end; { DrawBox }
  1139.  
  1140. begin
  1141.   MainWindow('User defined fill styles');
  1142.   GetViewSettings(ViewInfo);
  1143.   with ViewInfo do
  1144.   begin
  1145.     Width := 2 * ((x2+1) div 13);
  1146.     Height := 2 * ((y2-10) div 10);
  1147.   end;
  1148.   X := Width div 2;
  1149.   Y := Height div 2;
  1150.   Style := 0;
  1151.   for J := 1 to 3 do
  1152.   begin
  1153.     for I := 1 to 4 do
  1154.     begin
  1155.       DrawBox(X, Y);
  1156.       Inc(X, (Width div 2) * 3);
  1157.     end;
  1158.     X := Width div 2;
  1159.     Inc(Y, (Height div 2) * 3);
  1160.   end;
  1161.   SetTextJustify(LeftText, TopText);
  1162.   WaitToGo;
  1163. end; { FillPatternPlay }
  1164.  
  1165. procedure ColorPlay;
  1166. { Display all of the colors available for the current driver and mode }
  1167. var
  1168.   Color    : word;
  1169.   Width    : word;
  1170.   Height   : word;
  1171.   X, Y     : word;
  1172.   I, J     : word;
  1173.   ViewInfo : ViewPortType;
  1174.  
  1175. procedure DrawBox(X, Y : word);
  1176. begin
  1177.   SetFillStyle(SolidFill, Color);
  1178.   SetColor(Color);
  1179.   with ViewInfo do
  1180.     Bar(X, Y, X+Width, Y+Height);
  1181.   Rectangle(X, Y, X+Width, Y+Height);
  1182.   Color := GetColor;
  1183.   if Color = 0 then
  1184.   begin
  1185.     SetColor(MaxColor);
  1186.     Rectangle(X, Y, X+Width, Y+Height);
  1187.   end;
  1188.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Color));
  1189.   Color := Succ(Color) mod (MaxColor + 1);
  1190. end; { DrawBox }
  1191.  
  1192. begin
  1193.   MainWindow('Color demonstration');
  1194.   Color := 1;
  1195.   GetViewSettings(ViewInfo);
  1196.   with ViewInfo do
  1197.   begin
  1198.     Width := 2 * ((x2+1) div 16);
  1199.     Height := 2 * ((y2-10) div 10);
  1200.   end;
  1201.   X := Width div 2;
  1202.   Y := Height div 2;
  1203.   for J := 1 to 3 do
  1204.   begin
  1205.     for I := 1 to 5 do
  1206.     begin
  1207.       DrawBox(X, Y);
  1208.       Inc(X, (Width div 2) * 3);
  1209.     end;
  1210.     X := Width div 2;
  1211.     Inc(Y, (Height div 2) * 3);
  1212.   end;
  1213.   WaitToGo;
  1214. end; { ColorPlay }
  1215.  
  1216. procedure PalettePlay;
  1217. { Demonstrate the use of the SetPalette command }
  1218. const
  1219.   XBars = 15;
  1220.   YBars = 10;
  1221. var
  1222.   I, J     : word;
  1223.   X, Y     : word;
  1224.   Color    : word;
  1225.   ViewInfo : ViewPortType;
  1226.   Width    : word;
  1227.   Height   : word;
  1228.   OldPal   : PaletteType;
  1229. begin
  1230.   GetPalette(OldPal);
  1231.   MainWindow('Palette demonstration');
  1232.   StatusLine('Press any key...');
  1233.   GetViewSettings(ViewInfo);
  1234.   with ViewInfo do
  1235.   begin
  1236.     Width := (x2-x1) div XBars;
  1237.     Height := (y2-y1) div YBars;
  1238.   end;
  1239.   X := 0; Y := 0;
  1240.   Color := 0;
  1241.   for J := 1 to YBars do
  1242.   begin
  1243.     for I := 1 to XBars do
  1244.     begin
  1245.       SetFillStyle(SolidFill, Color);
  1246.       Bar(X, Y, X+Width, Y+Height);
  1247.       Inc(X, Width+1);
  1248.       Inc(Color);
  1249.       Color := Color mod (MaxColor+1);
  1250.     end;
  1251.     X := 0;
  1252.     Inc(Y, Height+1);
  1253.   end;
  1254.   repeat
  1255.     SetPalette(Random(GetMaxColor + 1), Random(65));
  1256.   until KeyPressed;
  1257.   SetAllPalette(OldPal);
  1258.   WaitToGo;
  1259. end; { PalettePlay }
  1260.  
  1261. procedure CrtModePlay;
  1262. { Demonstrate the use of RestoreCrtMode and SetGraphMode }
  1263. var
  1264.   ViewInfo : ViewPortType;
  1265.   Ch       : char;
  1266. begin
  1267.   MainWindow('SetGraphMode / RestoreCrtMode demo');
  1268.   GetViewSettings(ViewInfo);
  1269.   SetTextJustify(CenterText, CenterText);
  1270.   with ViewInfo do
  1271.   begin
  1272.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Now you are in graphics mode');
  1273.     StatusLine('Press any key for text mode...');
  1274.     repeat until KeyPressed;
  1275.     Ch := ReadKey;
  1276.     if ch = #0 then ch := readkey;    { trap function keys }
  1277.     RestoreCrtmode;
  1278.     Writeln('Now you are in text mode.');
  1279.     Write('Press any key to go back to graphics...');
  1280.     repeat until KeyPressed;
  1281.     Ch := ReadKey;
  1282.     if ch = #0 then ch := readkey;    { trap function keys }
  1283.     SetGraphMode(GetGraphMode);
  1284.     MainWindow('SetGraphMode / RestoreCrtMode demo');
  1285.     SetTextJustify(CenterText, CenterText);
  1286.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'Back in graphics mode...');
  1287.   end;
  1288.   WaitToGo;
  1289. end; { CrtModePlay }
  1290.  
  1291. procedure LineStylePlay;
  1292. { Demonstrate the predefined line styles available }
  1293. var
  1294.   Style    : word;
  1295.   Step     : word;
  1296.   X, Y     : word;
  1297.   ViewInfo : ViewPortType;
  1298.  
  1299. begin
  1300.   ClearDevice;
  1301.   DefaultColors;
  1302.   MainWindow('Pre-defined line styles');
  1303.   GetViewSettings(ViewInfo);
  1304.   with ViewInfo do
  1305.   begin
  1306.     X := 35;
  1307.     Y := 10;
  1308.     Step := (x2-x1) div 11;
  1309.     SetTextJustify(LeftText, TopText);
  1310.     OutTextXY(X, Y, 'NormWidth');
  1311.     SetTextJustify(CenterText, TopText);
  1312.     for Style := 0 to 3 do
  1313.     begin
  1314.       SetLineStyle(Style, 0, NormWidth);
  1315.       Line(X, Y+20, X, Y2-40);
  1316.       OutTextXY(X, Y2-30, Int2Str(Style));
  1317.       Inc(X, Step);
  1318.     end;
  1319.     Inc(X, 2*Step);
  1320.     SetTextJustify(LeftText, TopText);
  1321.     OutTextXY(X, Y, 'ThickWidth');
  1322.     SetTextJustify(CenterText, TopText);
  1323.     for Style := 0 to 3 do
  1324.     begin
  1325.       SetLineStyle(Style, 0, ThickWidth);
  1326.       Line(X, Y+20, X, Y2-40);
  1327.       OutTextXY(X, Y2-30, Int2Str(Style));
  1328.       Inc(X, Step);
  1329.     end;
  1330.   end;
  1331.   SetTextJustify(LeftText, TopText);
  1332.   WaitToGo;
  1333. end; { LineStylePlay }
  1334.  
  1335. procedure UserLineStylePlay;
  1336. { Demonstrate user defined line styles }
  1337. var
  1338.   Style    : word;
  1339.   X, Y, I  : word;
  1340.   ViewInfo : ViewPortType;
  1341. begin
  1342.   MainWindow('User defined line styles');
  1343.   GetViewSettings(ViewInfo);
  1344.   with ViewInfo do
  1345.   begin
  1346.     X := 4;
  1347.     Y := 10;
  1348.     Style := 0;
  1349.     I := 0;
  1350.     while X < X2-4 do
  1351.     begin
  1352.       {$B+}
  1353.       Style := Style or (1 shl (I mod 16));
  1354.       {$B-}
  1355.       SetLineStyle(UserBitLn, Style, NormWidth);
  1356.       Line(X, Y, X, (y2-y1)-Y);
  1357.       Inc(X, 5);
  1358.       Inc(I);
  1359.       if Style = 65535 then
  1360.       begin
  1361.         I := 0;
  1362.         Style := 0;
  1363.       end;
  1364.     end;
  1365.   end;
  1366.   WaitToGo;
  1367. end; { UserLineStylePlay }
  1368.  
  1369.  
  1370. procedure SayGoodbye;
  1371. { Say goodbye and then exit the program }
  1372. var
  1373.   ViewInfo : ViewPortType;
  1374. begin
  1375.   MainWindow('');
  1376.   GetViewSettings(ViewInfo);
  1377.   SetTextStyle(TriplexFont, HorizDir, 4);
  1378.   SetTextJustify(CenterText, CenterText);
  1379.   with ViewInfo do
  1380.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  1381.   StatusLine('Press any key to quit...');
  1382.   repeat until KeyPressed;
  1383. end; { SayGoodbye }
  1384.  
  1385. begin { program body }
  1386.   Initialize;
  1387.   ReportStatus;
  1388.  
  1389.   AspectRatioPlay;
  1390.   FillEllipsePlay;
  1391.   SectorPlay;
  1392.   WriteModePlay;
  1393.  
  1394.   ColorPlay;
  1395.   { PalettePlay only intended to work on these drivers: }
  1396.   if (GraphDriver = EGA) or
  1397.      (GraphDriver = EGA64) or
  1398.      (GraphDriver = VGA) then
  1399.     PalettePlay;
  1400.   PutPixelPlay;
  1401.   PutImagePlay;
  1402.   RandBarPlay;
  1403.   BarPlay;
  1404.   Bar3DPlay;
  1405.   ArcPlay;
  1406.   CirclePlay;
  1407.   PiePlay;
  1408.   LineToPlay;
  1409.   LineRelPlay;
  1410.   LineStylePlay;
  1411.   UserLineStylePlay;
  1412.   TextDump;
  1413.   TextPlay;
  1414.   CrtModePlay;
  1415.   FillStylePlay;
  1416.   FillPatternPlay;
  1417.   PolyPlay;
  1418.   SayGoodbye;
  1419.   CloseGraph;
  1420. end.
  1421.