Category : Files from Magazines
Archive   : DDJ0990.ZIP
Filename : LADD.ASC
by Scott Robert Ladd
[LISTING ONE]
UNIT Shapes;
INTERFACE
USES Graph, Crt;
TYPE
{---------- Shape class ----------}
Shape = OBJECT
Color : BYTE;
PROCEDURE Draw; VIRTUAL;
END;
ShapePtr = ^Shape;
{---------- Box class ----------}
Box = OBJECT (Shape)
LowerRightX, LowerRightY : INTEGER;
UpperLeftX, UpperLeftY : INTEGER;
CONSTRUCTOR Create(ulx, uly, lrx, lry, c : INTEGER);
PROCEDURE Draw; VIRTUAL;
END;
{---------- Ring class ----------}
Ring = OBJECT (Shape)
Xcenter, Ycenter : INTEGER;
Radius : INTEGER;
CONSTRUCTOR Create(x, y, rad, c : INTEGER);
PROCEDURE Draw; VIRTUAL;
END;
IMPLEMENTATION
{---------- Shape methods ----------}
PROCEDURE Shape.Draw;
BEGIN
{ Does nothing; it's a virtual method place-holder }
END;
{---------- Box methods ----------}
CONSTRUCTOR Box.Create(ulx, uly, lrx, lry, c : INTEGER);
BEGIN
UpperLeftX := ulx;
UpperLeftY := uly;
LowerRightX := lrx;
LowerRightY := lry;
Color := c;
END;
PROCEDURE Box.Draw;
BEGIN
SetColor(Color);
Rectangle(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY);
END;
{---------- Ring methods ----------}
CONSTRUCTOR Ring.Create(x, y, rad, c : INTEGER);
BEGIN
Xcenter := x;
Ycenter := y;
Radius := rad;
Color := c;
END;
PROCEDURE Ring.Draw;
BEGIN
SetColor(Color);
Circle(Xcenter, Ycenter, Radius);
END;
END. { UNIT Shapes }
[LISTING TWO]
PROGRAM Program1;
USES Graph, Crt, Shapes;
VAR
R : Ring;
B : Box;
GrDriver, GrMode, GrResult : INTEGER;
ch : CHAR;
PROCEDURE DrawShape(s : ShapePtr);
BEGIN
s^.Draw;
END;
BEGIN
R.Create(100,100,90,2);
B.Create(25,10,175,175,4);
GrDriver := DETECT;
InitGraph(GrDriver,GrMode,'d:\tp');
GrResult := GraphResult;
IF GrResult <> GrOK THEN
BEGIN
WriteLn('Unable to initialize BGI: error ',grResult);
Halt(1);
END;
DrawShape(@R);
DrawShape(@B);
REPEAT UNTIL KeyPressed;
Ch := ReadKey;
CloseGraph;
END.
[LISTING THREE]
PROGRAM Program2;
USES Graph, Crt, Shapes;
VAR
R1, R2 : Ring;
B1, B2 : Box;
F : FILE;
GrDriver, GrMode, GrResult : INTEGER;
ch : CHAR;
BEGIN
R1.Create(100,100,90,2);
R2.Create(0,0,0,0);
B1.Create(25,10,175,150,4);
B2.Create(0,0,0,0,0);
GrDriver := DETECT;
InitGraph(GrDriver,GrMode,'d:\tp');
GrResult := GraphResult;
IF GrResult <> GrOK THEN
BEGIN
WriteLn('Unable to initialize BGI: error ',grResult);
Halt(1);
END;
Assign(F,'shapes.fil');
Rewrite(F,1);
BlockWrite(F,R1,SizeOf(R1));
BlockWrite(F,B1,SizeOf(B1));
Close(F);
Assign(F,'shapes.fil');
Reset(F,1);
BlockRead(F,R2,SizeOf(R2));
BlockRead(F,B2,SizeOf(B2));
R2.Draw;
B2.Draw;
REPEAT UNTIL KeyPressed;
Ch := ReadKey;
Close(F);
CloseGraph;
END.
[LISTING FOUR]
UNIT Shapes;
INTERFACE
USES Graph, Crt;
TYPE
{---------- Shape class ----------}
Shape = OBJECT
Color : BYTE;
PROCEDURE Draw; VIRTUAL;
PROCEDURE FWrite(VAR f : FILE); VIRTUAL;
PROCEDURE FRead(VAR f : FILE); VIRTUAL;
END;
ShapePtr = ^Shape;
{---------- Box class ----------}
Box = OBJECT (Shape)
UpperLeftX, UpperLeftY : INTEGER;
LowerRightX, LowerRightY : INTEGER;
CONSTRUCTOR Create(ulx, uly, lrx, lry, c : INTEGER);
PROCEDURE Draw; VIRTUAL;
PROCEDURE FWrite(VAR f : FILE); VIRTUAL;
PROCEDURE FRead(VAR f : FILE); VIRTUAL;
END;
{---------- Ring class ----------}
Ring = OBJECT (Shape)
Xcenter, Ycenter : INTEGER;
Radius : INTEGER;
CONSTRUCTOR Create(x, y, rad, c : INTEGER);
PROCEDURE Draw; VIRTUAL;
PROCEDURE FWrite(VAR f : FILE); VIRTUAL;
PROCEDURE FRead(VAR f : FILE); VIRTUAL;
END;
IMPLEMENTATION
{---------- Shape methods ----------}
PROCEDURE Shape.Draw;
BEGIN
END;
PROCEDURE Shape.FWrite(VAR f : FILE);
BEGIN
END;
PROCEDURE Shape.FRead(VAR f : FILE);
BEGIN
END;
{---------- Box methods ----------}
CONSTRUCTOR Box.Create(ulx, uly, lrx, lry, c : INTEGER);
BEGIN
UpperLeftX := ulx;
UpperLeftY := uly;
LowerRightX := lrx;
LowerRightY := lry;
Color := c;
END;
PROCEDURE Box.Draw;
BEGIN
SetColor(Color);
Rectangle(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY);
END;
PROCEDURE Box.FWrite(VAR f : FILE);
BEGIN
BlockWrite(f,Color, SizeOf(INTEGER));
BlockWrite(f,UpperLeftX, SizeOf(INTEGER));
BlockWrite(f,UpperLeftY, SizeOf(INTEGER));
BlockWrite(f,LowerRightX,SizeOf(INTEGER));
BlockWrite(f,LowerRightY,SizeOf(INTEGER));
END;
PROCEDURE Box.FRead(VAR f : FILE);
BEGIN
BlockRead(f,Color, SizeOf(INTEGER));
BlockRead(f,UpperLeftX, SizeOf(INTEGER));
BlockRead(f,UpperLeftY, SizeOf(INTEGER));
BlockRead(f,LowerRightX,SizeOf(INTEGER));
BlockRead(f,LowerRightY,SizeOf(INTEGER));
END;
{---------- Ring methods ----------}
CONSTRUCTOR Ring.Create(x, y, rad, c : INTEGER);
BEGIN
Xcenter := x;
Ycenter := y;
Radius := rad;
Color := c;
END;
PROCEDURE Ring.Draw;
BEGIN
SetColor(Color);
Circle(Xcenter, Ycenter, Radius);
END;
PROCEDURE Ring.FWrite(VAR f : FILE);
BEGIN
BlockWrite(f,Color, SizeOf(INTEGER));
BlockWrite(f,Xcenter, SizeOf(INTEGER));
BlockWrite(f,Ycenter, SizeOf(INTEGER));
BlockWrite(f,Radius, SizeOf(INTEGER));
END;
PROCEDURE Ring.FRead(VAR f : FILE);
BEGIN
BlockRead(f,Color, SizeOf(INTEGER));
BlockRead(f,Xcenter, SizeOf(INTEGER));
BlockRead(f,Ycenter, SizeOf(INTEGER));
BlockRead(f,Radius, SizeOf(INTEGER));
END;
END. { UNIT Shapes }
[LISTING FIVE]
PROGRAM Program3;
USES Graph, Crt, Shapes;
VAR
R1, R2 : Ring;
B1, B2 : Box;
F : FILE;
GrDriver, GrMode, GrResult : INTEGER;
ch : CHAR;
BEGIN
R1.Create(100,100,90,2);
R2.Create(0,0,0,0);
B1.Create(25,10,175,150,4);
B2.Create(0,0,0,0,0);
GrDriver := DETECT;
InitGraph(GrDriver,GrMode,'d:\tp');
GrResult := GraphResult;
IF GrResult <> GrOK THEN
BEGIN
WriteLn('Unable to initialize BGI: error ',grResult);
Halt(1);
END;
Assign(F,'shapes.fil');
Rewrite(F,1);
R1.FWrite(F);
B1.FWrite(F);
Close(F);
Assign(F,'shapes.fil');
Reset(F,1);
R2.FRead(F);
B2.FRead(F);
R2.Draw;
B2.Draw;
REPEAT UNTIL KeyPressed;
Ch := ReadKey;
Close(F);
CloseGraph;
END.
[Example 1: Representing the Box object as a Turbo Pascal record.]
BoxRec = RECORD
BEGIN
Color : INTEGER;
UpperLeftX, UpperLeftY : INTEGER;
LowerRightX, LowerRightY : INTEGER;
END;
[Example 2: A first attempt at writing a procedure to store a
persistent object.]
PROCEDURE WriteShape(f : FILE; s : ^Shape);
BEGIN
BlockWrite(f,s,SizeOf(s^));
END;
[Example 3: A generic WriteShape procedure to store persistent
objects.]
PROCEDURE WriteShape(f : FILE; s : ^Shape);
BEGIN
s->FWrite(f);
END;
[Example 4: A Storable base class (object type) that emulates the
features of the Eiffel STORABLE class.]
Storable = OBJECT
BEGIN
PROCEDURE FWrite(f : FILE);
PROCEDURE FRead(f : FILE);
END;
Shape = OBJECT (Storable)
BEGIN
Color : INTEGER;
PROCEDURE Draw; VIRTUAL;
END;
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/