home *** CD-ROM | disk | FTP | other *** search
-
- { Turbo Figures }
- { Copyright (c) 1989 by Borland Interational, Inc. }
-
- unit Figures;
- { From P-42 of the Object-Oriented Programming Guide.
- Virtual methods & polymorphic objects.
- }
-
- interface
-
- uses Graph, Crt;
-
- type
- Location = object
- X,Y : Integer;
- procedure Init(InitX, InitY : Integer);
- function GetX : Integer;
- function GetY : Integer;
- end;
-
- PointPtr = ^Point;
-
- Point = object (Location)
- Visible : Boolean;
- constructor Init(InitX, InitY : Integer);
- destructor Done; virtual;
- procedure Show; virtual;
- procedure Hide; virtual;
- function IsVisible : Boolean;
- procedure MoveTo(NewX, NewY : Integer);
- procedure Drag(DragBy : Integer); virtual;
- end;
-
- CirclePtr = ^Circle;
-
- Circle = object (Point)
- Radius : Integer;
- constructor Init(InitX, InitY : Integer;
- InitRadius : Integer);
- procedure Show; virtual;
- procedure Hide; virtual;
- procedure Expand(ExpandBy : Integer); virtual;
- procedure Contract(ContractBy : Integer); virtual;
- end;
-
- implementation
-
- {--------------------------------------------------------}
- { Location's method implementations: }
- {--------------------------------------------------------}
-
- procedure Location.Init(InitX, InitY : Integer);
-
- begin
- X := InitX;
- Y := InitY;
- end;
-
- function Location.GetX : Integer;
- begin
- GetX := X;
- end;
-
- function Location.GetY : Integer;
- begin
- GetY := Y;
- end;
-
-
- {--------------------------------------------------------}
- { Points's method implementations: }
- {--------------------------------------------------------}
-
- constructor Point.Init(InitX, InitY : Integer);
- begin
- Location.Init(InitX, InitY);
- Visible := False;
- end;
-
- destructor Point.Done;
- begin
- Hide;
- end;
-
- procedure Point.Show;
- begin
- Visible := True;
- PutPixel(X, Y, GetColor);
- end;
-
- procedure Point.Hide;
- begin
- Visible := False;
- PutPixel(X, Y, GetBkColor);
- end;
-
- function Point.IsVisible : Boolean;
- begin
- IsVisible := Visible;
- end;
-
- procedure Point.MoveTo(NewX, NewY : Integer);
- begin
- Hide;
- X := NewX;
- Y := NewY;
- Show;
- end;
-
- function GetDelta(var DeltaX : Integer;
- var DeltaY : Integer) : Boolean;
- var
- KeyChar : Char;
- Quit : Boolean;
- begin
- DeltaX := 0; DeltaY := 0; { 0 means no change in position; }
- GetDelta := True; { True means we return a delta }
- repeat
- KeyChar := ReadKey; { First, read the keystroke }
- Quit := True; { Assume it's a useable key }
- case Ord(KeyChar) of
- 0: begin { 0 means an extended, 2-byte code }
- KeyChar := ReadKey; { Read second byte of code }
- case Ord(KeyChar) of
- 72: DeltaY := -1; { Up arrow; decrement Y }
- 80: DeltaY := 1; { Down arrow; increment Y }
- 75: DeltaX := -1; { Left arrow; decrement X }
- 77: DeltaX := 1; { Right arrow; increment X }
- else Quit := False; { Ignore any other code }
- end; { case }
- end;
- 13: GetDelta := False; { CR pressed means no delta }
- else Quit := False; { Ignore any other keystroke }
- end; { case }
- until Quit;
- end;
-
- procedure Point.Drag(DragBy : Integer);
- var
- DeltaX, DeltaY : Integer;
- FigureX, FigureY : Integer;
- begin
- Show; { Display figure to be dragged }
- FigureX := GetX; { Get the initial position of figure }
- FigureY := GetY;
-
- { This is the drag loop : }
- while GetDelta(DeltaX, DeltaY) do
- begin { Apply delta to figure X,Y: }
- FigureX := FigureX + (DeltaX * DragBy);
- FigureY := FigureY + (DeltaY * DragBy);
- MoveTo(FigureX, FigureY); { And tell the figure to move }
- end;
- end;
-
- {--------------------------------------------------------}
- { Circle's method implementations: }
- {--------------------------------------------------------}
-
- constructor Circle.Init(InitX, InitY : Integer;
- InitRadius : Integer);
- begin
- Point.Init(InitX, InitY);
- Radius := InitRadius;
- end;
-
- procedure Circle.Show;
- begin
- Visible := True;
- Graph.Circle(X, Y, Radius);
- end;
-
- procedure Circle.Hide;
- var
- TempColor : Word;
- begin
- TempColor := Graph.GetColor;
- Graph.SetColor(GetBkColor);
- Visible := False;
- Graph.Circle(X, Y, Radius);
- Graph.SetColor(TempColor);
- end;
-
- procedure Circle.Expand(ExpandBy : Integer);
- begin
- Hide;
- Radius := Radius + ExpandBy;
- if Radius <0 then Radius := 0;
- Show;
- end;
-
- procedure Circle.Contract(ContractBy : Integer);
- begin
- Expand(-ContractBy);
- end;
-
- { No initialization section }
-
- end.