home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
insidetp
/
1990_06
/
vidgraph.pas
< prev
Wrap
Pascal/Delphi Source File
|
1990-05-10
|
7KB
|
226 lines
PROGRAM VidGraph;
{ This program demonstrates some of Turbo Pascal's
graphics routines.
Requires the TP BGI drivers in the current
directory or an environment variable, BGI,
that points to it, e.g.:
BGI = D:\TP\GRAPH }
USES Graph,Dos;
CONST
NoGraphHardware = -2;
TYPE
VideoHW = (Autodetect, CGA, MCGA, EGA, EGA64,
EGAMONO, IBM8514, HERCMONO, ATT400,
VGA, PC3270);
VidRecord = RECORD
VType : String[10];
Offset : Byte;
END;
VidHwType = ARRAY[0..10] OF VidRecord;
DescType = ARRAY[0..28] OF String[50];
CONST
VidHardware : VidHwType =
((VType:'Autodetect' ;Offset:0),
(VType:'CGA' ;Offset:0),
(VType:'MCGA' ;Offset:5),
(VType:'EGA' ;Offset:11),
(VType:'EGA64' ;Offset:13),
(VType:'EGAMONO' ;Offset:15),
(VType:'IBM8514' ;Offset:16),
(VType:'HERCMONO' ;Offset:18),
(VType:'ATT400' ;Offset:19),
(VType:'VGA' ;Offset:25),
(VType:'PC3270' ;Offset:28));
VidGraphModes : DescType = (
(* CGA *)
'CGAC0 (320x200, palette 0, 1 page)',
'CGAC1 (320x200, palette 1, 1 page)',
'CGAC2 (320x200, palette 2, 1 page)',
'CGAC3 (320x200, palette 3, 1 page)',
'CGAHI (640x200, 1 page)',
(* MCGA (offset 5) *)
'MCGAC0 (320x200, palette 0, 1 page)',
'MCGAC1 (320x200, palette 1, 1 page)',
'MCGAC2 (320x200, palette 2, 1 page)',
'MCGAC3 (320x200, palette 3, 1 page)',
'MCGAMED (640x200, 1 page)',
'MCGAHI (640x200, 1 page)',
(* EGA (offset 11) *)
'EGALO (640x200, 16 colors, 4 pages)',
'EGAHI (640x350, 16 colors, 2 pages)',
(* EGA64 (offset 13) *)
'EGA64LO (640x200, 16 colors, 1 page)',
'EGA64HI (640x350, 4 colors, 1 page)',
(* EGAMONO (offset 15) *)
'EGAMONOHI (640x350, 64k-1 pg; 256k-4 pgs)',
(* IBM8514 (offset 16) *)
'IBM8514LO (640x480, 256 colors)',
'IBM8514HI (1024x768, 256 colors)',
(* HERC (offset 18) *)
'HERCMONOHI (720x348 2 pages)',
(* ATT400 (offset 19) *)
'ATT400C0 (320x200, palette 0, 1 page)',
'ATT400C1 (320x200, palette 1, 1 page)',
'ATT400C2 (320x200, palette 2, 1 page)',
'ATT400C3 (320x200, palette 3, 1 page)',
'ATT400MED (640x200, 1 page)',
'ATT400HI (640X400, 1 page)',
(* VGA (offset 25) *)
'VGALO (640x200, 16 colors, 4 pages)' ,
'VGAMED (640x350, 16 colors, 2 pages)',
'VGAHI (640x480, 16 colors, 1 page)',
(* PC3270 (offset 28) *)
'PC3270HI (720x350, 1 page)');
Const
MAXRECTS = 100;
{ this procedure draws a set of concentric
rectangles in the default color }
PROCEDURE ConcentricRectangles;
VAR
I, LeftTop, RightBott, MaxX, MaxY : Integer;
BEGIN
MaxX := GetMaxX;
MaxY := GetMaxY;
FOR I := 7 TO MAXRECTS - 58 DO
BEGIN
LeftTop := MAXRECTS - (2 * I);
RightBott := 10*(I+2);
IF (LeftTop >= 0) AND
(RightBott <= MaxX) AND
(RightBott <= MaxY) THEN
Rectangle(LeftTop,LeftTop,RightBott,
RightBott)
END
END;
CONST
TunnelRects = 10;
{ This procedure draws a tunnel of rectangles
from upper left to lower right, each in
a different highlighted color }
PROCEDURE TunnelRectangles;
VAR
I, LeftTop, RightBott, MaxX, MaxY : Integer;
Depth, Color : Word;
BEGIN
MaxX := GetMaxX;
MaxY := GetMaxY;
Color := LightBlue;
FOR I := 0 TO MaxRects-1 DO
BEGIN
LeftTop := (TunnelRects - 2) * I;
RightBott := 10 * (I + 2);
IF (LeftTop >= 0) AND
(RightBott <= MaxX) AND
(RightBott <= MaxY) THEN
BEGIN
SetColor(Color);
IF (Color = White) THEN
Color := DarkGray;
Rectangle(LeftTop,LeftTop,RightBott,
RightBott);
Inc(Color)
END
END
END;
{ This procedure draws a tunnel of cubes from
upper left to lower right }
PROCEDURE TunnelCubes;
CONST
MaxCubes = 50;
CubeStart = 10;
VAR
I, LeftTop, RightBott, MaxX, MaxY : Integer;
Depth : Word;
BEGIN
MaxX := GetMaxX;
MaxY := GetMaxY;
FOR I := 3 TO MaxCubes - 1 DO
BEGIN
LeftTop := (CubeStart - 2) * I;
RightBott := 10 * (I + 2);
Depth := ((RightBott - LeftTop) DIV 4) + I;
IF (LeftTop >= 0) AND
(RightBott <= MaxX) AND
(RightBott <= MaxY) THEN
Bar3D(LeftTop,LeftTop,RightBott,
RightBott,Depth,TRUE)
END
END;
{ Displays the message at the left-most
column at the bottom of the screen, then
waits for a keypress }
PROCEDURE Pause;
VAR
Msg : String;
BEGIN
Msg := 'Press Enter to continue...';
OutTextXY(0,GetMaxY-(TextHeight(Msg)*2),Msg);
Readln
end;
{ Displays error #, message and exits }
PROCEDURE ErrorExit(ErrCode: Integer;
Message: String);
BEGIN
WriteLn('Error ',ErrCode:3,' returned from ',
Message);
Halt(0)
end;
var
GraphDriver, GraphMode : Integer;
BGIPath, ErrMsg : String[80];
Begin
{ Get recommended driver }
GraphDriver := Detect;
DetectGraph(GraphDriver,GraphMode);
IF (GraphDriver = NoGraphHardware) THEN
ErrorExit(NoGraphHardware,
'DetectGraph(No graphics hardware detected)');
WriteLn('DetectGraph() detects ',
VidHardware[GraphDriver].VType,
' video hardware in your System...');
WriteLn('and recommends loading the ',
VidGraphModes[GraphMode +
VidHardware[GraphDriver].Offset],
' driver.');
Write('Press Enter to continue...');
ReadLn;
{ Initialize graphics system }
BGIPath := GetEnv('BGI');
InitGraph(GraphDriver,GraphMode,BGIPath);
if (graphdriver < 0) then
Begin
ErrMsg := 'InitGraph (' +
GraphErrorMsg(GraphDriver) + ')';
ErrorExit(GraphDriver,ErrMsg);
end;
{ Set drawing color to light cyan }
SetColor(LightCyan);
{ Draw concentric rectangles }
ConcentricRectangles;
{ Set font to triplex, normal size }
SetTextStyle(TriplexFont,HorizDir,1);
Pause;
{ Clear the screen }
ClearDevice;
{ Draw tunnel of rectangles }
TunnelRectangles;
{ Set font to small font, 4x size }
SetTextStyle(SmallFont,HorizDir,0);
Pause;
ClearDevice;
{ Draw tunnel of cubes (3d bars) }
TunnelCubes;
{ Set font to gothic, 4x size }
SetTextStyle(GothicFont,HorizDir,0);
Pause;
{ Switch back to text mode, cleanup}
CloseGraph;
END.