home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPJUN90.ZIP / VIDGRAPH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-05-10  |  6.7 KB  |  226 lines
  1. PROGRAM VidGraph;
  2. { This program demonstrates some of Turbo Pascal's
  3.   graphics routines.
  4.   Requires the TP BGI drivers in the current
  5.   directory or an environment variable, BGI,
  6.   that points to it, e.g.:
  7.                  BGI = D:\TP\GRAPH              }
  8. USES Graph,Dos;
  9. CONST
  10.    NoGraphHardware = -2;
  11. TYPE
  12.    VideoHW = (Autodetect, CGA, MCGA, EGA, EGA64,
  13.               EGAMONO, IBM8514, HERCMONO, ATT400,
  14.               VGA, PC3270);
  15.    VidRecord = RECORD
  16.       VType   : String[10];
  17.       Offset  : Byte;
  18.       END;
  19.    VidHwType = ARRAY[0..10] OF VidRecord;
  20.    DescType = ARRAY[0..28] OF String[50];
  21. CONST
  22.    VidHardware : VidHwType =
  23.               ((VType:'Autodetect' ;Offset:0),
  24.                (VType:'CGA'        ;Offset:0),
  25.                (VType:'MCGA'       ;Offset:5),
  26.                (VType:'EGA'        ;Offset:11),
  27.                (VType:'EGA64'      ;Offset:13),
  28.                (VType:'EGAMONO'    ;Offset:15),
  29.                (VType:'IBM8514'    ;Offset:16),
  30.                (VType:'HERCMONO'   ;Offset:18),
  31.                (VType:'ATT400'     ;Offset:19),
  32.                (VType:'VGA'        ;Offset:25),
  33.                (VType:'PC3270'     ;Offset:28));
  34.    VidGraphModes : DescType = (
  35.         (* CGA                  *)
  36.     'CGAC0 (320x200, palette 0, 1 page)',
  37.     'CGAC1 (320x200, palette 1, 1 page)',
  38.     'CGAC2 (320x200, palette 2, 1 page)',
  39.     'CGAC3 (320x200, palette 3, 1 page)',
  40.     'CGAHI (640x200, 1 page)',
  41.         (* MCGA (offset 5)      *)
  42.     'MCGAC0 (320x200, palette 0, 1 page)',
  43.     'MCGAC1 (320x200, palette 1, 1 page)',
  44.     'MCGAC2 (320x200, palette 2, 1 page)',
  45.     'MCGAC3 (320x200, palette 3, 1 page)',
  46.     'MCGAMED (640x200, 1 page)',
  47.     'MCGAHI  (640x200, 1 page)',
  48.         (* EGA (offset 11)      *)
  49.     'EGALO (640x200, 16 colors, 4 pages)',
  50.     'EGAHI (640x350, 16 colors, 2 pages)',
  51.         (* EGA64 (offset 13)    *)
  52.     'EGA64LO (640x200, 16 colors, 1 page)',
  53.     'EGA64HI (640x350, 4 colors, 1 page)',
  54.         (* EGAMONO (offset 15)  *)
  55.     'EGAMONOHI (640x350, 64k-1 pg; 256k-4 pgs)',
  56.         (* IBM8514 (offset 16)  *)
  57.     'IBM8514LO (640x480, 256 colors)',
  58.     'IBM8514HI (1024x768, 256 colors)',
  59.         (* HERC (offset 18)     *)
  60.     'HERCMONOHI (720x348 2 pages)',
  61.         (* ATT400 (offset 19)   *)
  62.     'ATT400C0 (320x200, palette 0, 1 page)',
  63.     'ATT400C1 (320x200, palette 1, 1 page)',
  64.     'ATT400C2 (320x200, palette 2, 1 page)',
  65.     'ATT400C3 (320x200, palette 3, 1 page)',
  66.     'ATT400MED (640x200, 1 page)',
  67.     'ATT400HI (640X400, 1 page)',
  68.         (* VGA (offset 25)      *)
  69.     'VGALO (640x200, 16 colors, 4 pages)' ,
  70.     'VGAMED (640x350, 16 colors, 2 pages)',
  71.     'VGAHI (640x480, 16 colors, 1 page)',
  72.         (* PC3270 (offset 28)   *)
  73.     'PC3270HI (720x350, 1 page)');
  74. Const
  75.    MAXRECTS = 100;
  76.    { this procedure draws a set of concentric
  77.      rectangles in the default color  }
  78.  
  79. PROCEDURE ConcentricRectangles;
  80. VAR
  81.    I, LeftTop, RightBott, MaxX, MaxY : Integer;
  82. BEGIN
  83.    MaxX := GetMaxX;
  84.    MaxY := GetMaxY;
  85.    FOR I := 7 TO MAXRECTS - 58 DO
  86.       BEGIN
  87.         LeftTop := MAXRECTS - (2 * I);
  88.         RightBott := 10*(I+2);
  89.         IF (LeftTop >= 0) AND
  90.            (RightBott <= MaxX) AND
  91.            (RightBott <= MaxY) THEN
  92.               Rectangle(LeftTop,LeftTop,RightBott,
  93.               RightBott)
  94.       END
  95. END;
  96.  
  97. CONST
  98.    TunnelRects = 10;
  99.  
  100. { This procedure draws a tunnel of rectangles
  101.   from upper left to lower right, each in
  102.   a different highlighted color   }
  103. PROCEDURE TunnelRectangles;
  104. VAR
  105.    I, LeftTop, RightBott, MaxX, MaxY : Integer;
  106.    Depth, Color : Word;
  107. BEGIN
  108.   MaxX := GetMaxX;
  109.   MaxY := GetMaxY;
  110.   Color := LightBlue;
  111.   FOR I := 0 TO MaxRects-1 DO
  112.     BEGIN
  113.       LeftTop := (TunnelRects - 2) * I;
  114.       RightBott := 10 * (I + 2);
  115.       IF (LeftTop >= 0) AND
  116.          (RightBott <= MaxX) AND
  117.          (RightBott <= MaxY) THEN
  118.         BEGIN
  119.           SetColor(Color);
  120.           IF (Color = White) THEN
  121.               Color := DarkGray;
  122.           Rectangle(LeftTop,LeftTop,RightBott,
  123.                     RightBott);
  124.           Inc(Color)
  125.         END
  126.    END
  127. END;
  128.  
  129. { This procedure draws a tunnel of cubes from
  130.   upper left to lower right }
  131. PROCEDURE TunnelCubes;
  132. CONST
  133.   MaxCubes = 50;
  134.   CubeStart = 10;
  135. VAR
  136.    I, LeftTop, RightBott, MaxX, MaxY : Integer;
  137.    Depth : Word;
  138. BEGIN
  139.   MaxX := GetMaxX;
  140.   MaxY := GetMaxY;
  141.   FOR I := 3 TO MaxCubes - 1 DO
  142.     BEGIN
  143.       LeftTop := (CubeStart - 2) * I;
  144.       RightBott := 10 * (I + 2);
  145.       Depth := ((RightBott - LeftTop) DIV 4) + I;
  146.       IF (LeftTop >= 0) AND
  147.          (RightBott <= MaxX) AND
  148.          (RightBott <= MaxY) THEN
  149.        Bar3D(LeftTop,LeftTop,RightBott,
  150.              RightBott,Depth,TRUE)
  151.     END
  152. END;
  153.  
  154. { Displays the message at the left-most
  155.   column at the bottom of the screen, then
  156.   waits for a keypress   }
  157. PROCEDURE Pause;
  158. VAR
  159.    Msg : String;
  160. BEGIN
  161.   Msg := 'Press Enter to continue...';
  162.   OutTextXY(0,GetMaxY-(TextHeight(Msg)*2),Msg);
  163.   Readln
  164. end;
  165.  
  166. { Displays error #, message and exits }
  167. PROCEDURE ErrorExit(ErrCode: Integer;
  168.                     Message: String);
  169. BEGIN
  170.   WriteLn('Error ',ErrCode:3,' returned from ',
  171.            Message);
  172.   Halt(0)
  173. end;
  174.  
  175. var
  176.   GraphDriver, GraphMode : Integer;
  177.   BGIPath, ErrMsg        : String[80];
  178. Begin
  179.   { Get recommended driver }
  180.   GraphDriver := Detect;
  181.   DetectGraph(GraphDriver,GraphMode);
  182.   IF (GraphDriver = NoGraphHardware) THEN
  183.     ErrorExit(NoGraphHardware,
  184.     'DetectGraph(No graphics hardware detected)');
  185.   WriteLn('DetectGraph() detects ',
  186.           VidHardware[GraphDriver].VType,
  187.           ' video hardware in your System...');
  188.   WriteLn('and recommends loading the ',
  189.           VidGraphModes[GraphMode +
  190.           VidHardware[GraphDriver].Offset],
  191.           ' driver.');
  192.   Write('Press Enter to continue...');
  193.   ReadLn;
  194.   { Initialize graphics system }
  195.   BGIPath := GetEnv('BGI');
  196.   InitGraph(GraphDriver,GraphMode,BGIPath);
  197.   if (graphdriver < 0) then
  198.     Begin
  199.       ErrMsg := 'InitGraph (' +
  200.                  GraphErrorMsg(GraphDriver) + ')';
  201.       ErrorExit(GraphDriver,ErrMsg);
  202.     end;
  203.   { Set drawing color to light cyan  }
  204.   SetColor(LightCyan);
  205.   { Draw concentric rectangles       }
  206.   ConcentricRectangles;
  207.   { Set font to triplex, normal size }
  208.   SetTextStyle(TriplexFont,HorizDir,1);
  209.   Pause;
  210.   { Clear the screen                 }
  211.   ClearDevice;
  212.   { Draw tunnel of rectangles        }
  213.   TunnelRectangles;
  214.   { Set font to small font, 4x size  }
  215.   SetTextStyle(SmallFont,HorizDir,0);
  216.   Pause;
  217.   ClearDevice;
  218.   { Draw tunnel of cubes (3d bars)   }
  219.   TunnelCubes;
  220.   { Set font to gothic, 4x size      }
  221.   SetTextStyle(GothicFont,HorizDir,0);
  222.   Pause;
  223.   { Switch back to text mode, cleanup}
  224.   CloseGraph;
  225. END.
  226.