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