[Back to OOP SWAG index] [Back to Main SWAG index] [Original]

    { see test program at the end of this unit !! }
    {************************************************}
    {                                                }
    {   UNIT GRAFOBJ   OOP graphical objects         }
    {   Copyright (c) 1994-97 by Tom Wellige         }
    {   Donated as FREEWARE                          }
    {                                                }
    {   Ortsmuehle 4, 44227 Dortmund, GERMANY        }
    {   E-Mail: wellige@itk.de                       }
    {                                                }
    {************************************************}

    (*
      Some few words on this unit:
      ----------------------------

       - This units works fine with Turbo Pascal 6 or higher. If you use
         TP/BP 7 you can use the "inherited" command as shown in the
         comment lines on each line where it is possible.

       - All INIT methods have at least the paramter VISIBLE. When calling
         an inhertied INIT this parameter is allways FALSE so only the
         inherited data fields will be updated, the inherited object will
         not be displayed. When using an instance of an object one can
         use VISIBLE TRUE to display the object on the screen.

       - The methode SHOW draws an object on the current position and the
         current color on the screen.

       - The methode HIDE deletes an object from the screen by redrawing it
         in the background color.

       - The methode MOVE moves an object on the screen by hiding it, changing
         the position and redrawing it.

       - The methode COPY copies an object to another position on the screen.
         The difference between COPY and MOVE is that COPY do not hide the
         object before changing the position. Note that from this point on
         you won't be able to access the "old" object since is only a copy
         and not the real object.

       - The methode CHANGECOLOR changes the color of an object by changing
         the field COLOR and calling SHOW.

       - The methode GETPOS returns the current coordinats X and Y of an
         object. If an object have more than one coordinate (e.g. rectangle)
         one have to calculate the otheres if they are of interest.

       - The methode GETCOLOR returns the current color of an object.

       - The methode ISINVIEW checks if an object is fully visible on the
         screen or has moved over one edge. It returns the following codes:

              0 = fully visible on screen
             -1 = passed across the left side of the screen
              1 = passed across the right side of the screen
             -2 = passed across the upper side of the screen
              2 = passed across the lower side of the screen

       - Some inheritances defining some specific methodes like
         CHANGERADIUS or CHANGELENGTH

    *)

    unit GrafObj;

    interface

    uses graph, objects;

    type
       PPoint = ^TPoint;
       TPoint = object(TObject)
           x, y, color, background: integer;
         constructor Init(ax, ay, acolor: integer; visible: boolean);
         procedure Show; virtual;                          { draw point      }
         procedure Hide; virtual;                          { delete point    }
         procedure Move(ax, ay: integer); virtual;         { move point      }
         procedure Copy(ax, ay: integer); virtual;         { copy point      }
         procedure ChangeColor(acolor: integer); virtual;  { change color    }
         procedure GetPos(var ax, ay: integer); virtual;   { request X and Y }
         function  GetColor: integer; virtual;             { request color   }
         function  IsInView: integer; virtual;             { is on screen ?  }
       end;

       PCircle = ^TCircle;
       TCircle = object(TPoint)
           radius: word;
         constructor Init(ax, ay, aradius, acolor: integer; visible: boolean);
         procedure Show; virtual;
         procedure Hide; virtual;
         function  IsInView: integer; virtual;
         procedure ChangeRadius(aradius: integer); virtual; { change radius  }
       end;

       PLine = ^TLine;
       TLine = object(TPoint)
           x2, y2: word;
         constructor Init(ax1, ay1, ax2, ay2, acolor: integer; visible: boolean);
         procedure Show; virtual;
         procedure Hide; virtual;
         procedure Move(ax, ay: integer); virtual;
         procedure Copy(ax, ay: integer); virtual;
         function  IsInView: integer; virtual;
         procedure ChangeLength(ax2, ay2: integer); virtual; { change length }
       end;

       PRectangle = ^TRectangle;
       TRectangle = object(TLine)
         procedure Show; virtual;
         procedure Hide; virtual;
       end;

       PTriangle = ^TTriangle;
       TTriangle = object(TLine)
           x3, y3: integer;
         constructor Init(ax1, ay1, ax2, ay2, ax3, ay3, acolor: integer;
                          visible: boolean);
         procedure Show; virtual;
         procedure Hide; virtual;
         procedure Move(ax, ay: integer); virtual;
         procedure Copy(ax, ay: integer); virtual;
         function  IsInView: integer; virtual;
       end;

    implementation

    (********************************************************************)
    (**                            TPoint                              **)
    (********************************************************************)

    constructor TPoint.Init(ax, ay, acolor: integer; visible: boolean);
    begin
      { TP/BP7: inherited Init; }
      TObject.Init;
      x:= ax;
      y:= ay;
      color:= acolor;
      background:= GetPixel(x, y);
      if visible then Show;
    end;

    procedure TPoint.Show;
    begin
      PutPixel(x, y, GetColor);
    end;

    procedure TPoint.Hide;
    begin
      PutPixel(x, y, background);
    end;

    procedure TPoint.Move(ax, ay: integer);
    begin
      Hide;
      x:= ax;
      y:= ay;
      Show;
    end;

    procedure TPoint.Copy(ax, ay: integer);
    begin
      x:= ax;
      y:= ay;
      Show;
    end;

    procedure TPoint.ChangeColor(acolor: integer);
    begin
      color:= acolor;
      Show;
    end;

    procedure TPoint.GetPos(var ax, ay: integer);
    begin
      ax:= x;
      ay:= y;
    end;

    function TPoint.GetColor: integer;
    begin
      GetColor:= color;
    end;

    function TPoint.IsInView: integer;
    begin
      if x < 1 then IsInView:= -1 else
        if x > GetMaxX then IsInView:= 1 else
          if y < 1 then IsInView:= -2 else
            if y > GetMaxY then IsInView:= 2 else
              IsInView:= 0;
    end;

    (********************************************************************)
    (**                            TCircle                             **)
    (********************************************************************)

    constructor TCircle.Init(ax, ay, aradius, acolor: integer;
                             visible: boolean);
    begin
      { TP/BP7: inherited Init(ax, ay, acolor, false); }
      TPoint.Init(ax, ay, acolor, false);
      radius:= aradius;
      if visible then Show;
    end;

    procedure TCircle.Show;
    begin
      SetColor(GetColor);
      Circle(x, y, radius);
    end;

    procedure TCircle.Hide;
    begin
      SetColor(background);
      Circle(x, y, radius);
    end;

    function TCircle.IsInView: integer;
    begin
      if x - radius < 0 then IsInView:= -1 else
        if x + radius > GetMaxX then IsInView:= 1 else
          if y - radius < 0 then IsInView:= -2 else
            if y + radius > GetMaxY then IsInView:= 2 else
              IsInView:= 0;
    end;

    procedure TCircle.ChangeRadius(aradius: integer);
    begin
      Hide;
      radius:= aradius;
      Show;
    end;

    (********************************************************************)
    (**                            TLine                               **)
    (********************************************************************)

    constructor TLine.Init(ax1, ay1, ax2, ay2, acolor: integer;
                           visible: boolean);
    begin
      { TP/BP7: inherited Init(ax1, ay1, acolor, false); }
      TPoint.Init(ax1, ay1, acolor, false);
      x2:= ax2;
      y2:= ay2;
      if visible then Show;
    end;

    procedure TLine.Show;
    begin
      SetColor(GetColor);
      Line(x, y, x2, y2);
    end;

    procedure TLine.Hide;
    begin
      SetColor(background);
      Line(x, y, x2, y2);
    end;

    procedure TLine.Move(ax, ay: integer);
    begin
      Hide;
      x2:= ax + (x2 - x);
      y2:= ay + (y2 - y);
      { TP/BP7: inherited Move(ax, ay); }
      TPoint.Move(ax, ay);
    end;

    procedure TLine.Copy(ax, ay: integer);
    begin
      x2:= ax + (x2 - x);
      y2:= ay + (y2 - y);
      { TP/BP7: inherited Copy(ax, ay); }
      TPoint.Copy(ax, ay);
    end;

    function TLine.IsInView: integer;
    begin
      if (x < 1) or (x2 < 1) then IsInView:= -1 else
        if (x > GetMaxX) or (x2 > GetMaxX) then IsInView:= 1 else
          if (y < 1) or (y2 < 1) then IsInView:= -2 else
            if (y > GetMaxY) or (y2 > GetMaxY) then IsInView:= 2 else
              IsInView:= 0;
    end;

    procedure TLine.ChangeLength(ax2, ay2: integer);
    begin
      Hide;
      x2:= ax2;
      y2:= ay2;
      Show;
    end;

    (********************************************************************)
    (**                           TRectangle                           **)
    (********************************************************************)

    procedure TRectangle.Show;
    begin
      SetColor(GetColor);
      Rectangle(x, y, x2, y2);
    end;

    procedure TRectangle.Hide;
    begin
      SetColor(background);
      Rectangle(x, y, x2, y2);
    end;

    (********************************************************************)
    (**                           TTriangle                            **)
    (********************************************************************)

    constructor TTriangle.Init(ax1, ay1, ax2, ay2, ax3, ay3, acolor: integer;
                               visible: boolean);
    begin
      { TP/BP7: inherited Init(ax1, ay1, ax2, ay2, acolor, false); }
      TLine.Init(ax1, ay1, ax2, ay2, acolor, false);
      x3:= ax3;
      y3:= ay3;
      if visible then Show;
    end;

    procedure TTriangle.Show;
    begin
      SetColor(GetColor);
      Line(x,y,   x2,y2);
      Line(x,y,   x3,y3);
      Line(x2,y2, x3,y3);
    end;

    procedure TTriangle.Hide;
    begin
      SetColor(background);
      Line(x,y,   x2,y2);
      Line(x,y,   x3,y3);
      Line(x2,y2, x3,y3);
    end;

    procedure TTriangle.Move(ax, ay: integer);
    var dx, dy: integer;
    begin
      Hide;
      dx:= x3 - x; x3:= ax + dx;
      dy:= y3 - y; y3:= ay + dy;
      dx:= x2 - x; x2:= ax + dx;
      dy:= y2 - y; y2:= ay + dy;
      x := ax;     y := ay;
      Show;
    end;

    procedure TTriangle.Copy(ax, ay: integer);
    var dx, dy: integer;
    begin
      dx:= x3 - x; x3:= ax + dx;
      dy:= y3 - y; y3:= ay + dy;
      dx:= x2 - x; x2:= ax + dx;
      dy:= y2 - y; y2:= ay + dy;
      x := ax;     y := ay;
      Show;
    end;

    function TTriangle.IsInView: integer;
    begin
      if (x < 1) or (x2 < 1) or (x3 < 1) then IsInView:= -1 else
        if (x > GetMaxX) or (x2 > GetMaxX) or (x3 > GetMaxX) then IsInView:= 1 else
          if (y < 1) or (y2 < 1) or (y3 < 1) then IsInView:= -2 else
            if (y > GetMaxY) or (y2 > GetMaxY) or (y3 > GetMaxY) then IsInView:= 2 else
              IsInView:= 0;
    end;

    end.

    {************************************************}
    {                                                }
    {   PROGRAM GRAFDEMO   Testapp for GRAFOBJ Unit  }
    {   Copyright (c) 1994-97 by Tom Wellige         }
    {   Donated as FREEWARE                          }
    {                                                }
    {   Ortsmuehle 4, 44227 Dortmund, GERMANY        }
    {   E-Mail: wellige@itk.de                       }
    {                                                }
    {************************************************}

    program grafdemo;

    uses crt, graph, grafobj;

    procedure DoGraphics;
    var
      xC, yC, cC, dCx, dCy: integer;
      xR, yR, cR, dRx, dRy: integer;
      xT, yT, cT, dTx, dTy: integer;
      C: TCircle;
      R: TRectangle;
      T: TTriangle;
    begin
      { Setting the coordinates of the first position and define the
        size of the "steps" the object makes on the screen. }
      xC:= 60; yC:= 60; cC:= 12; dCx:= 1; dCy:= 1;
      C.Init(xC, yC, 50, cC, true);

      xR:= 10; yR:= 160; cR:= 10; dRx:= -2; dRy:= 2;
      R.Init(xR, yR, xR+70, yR+50, cR, true);

      xT:= 200; yT:= 200; cT:= 14; dTx:= 1; dTy:= -1;
      T.Init(xT, yT, xT-30, yT+50, xT+30, yT+50, cT, true);

      repeat
        { Is object still fully visible on screen. If not change direction
          of moving. }
        case C.IsInView of
          -1: dCx:=  1;
           1: dCx:= -1;
          -2: dCy:=  1;
           2: dCy:= -1;
        end;

        case R.IsInView of
          -1: dRx:=  2;
           1: dRx:= -2;
          -2: dRy:=  2;
           2: dRy:= -2;
        end;

        case T.IsInView of
          -1: dTx:=  1;
           1: dTx:= -1;
          -2: dTy:=  1;
           2: dTy:= -1;
        end;

        { Calculate the new position and MOVE each object. One can also
          try COPY. }
        xC:= xC + dCx; yC:= yC + dCy;
        { C.Copy(xC, yC); }
        C.Move(xC, yC);

        xR:= xR + dRx; yR:= yR + dRy;
        { R.Copy(xR, yR); }
        R.Move(xR, yR);

        xT:= xT + dTx; yT:= yT + dTy;
        { T.Copy(xT, yT); }
        T.Move(xT, yT);

        delay(5);
      until keypressed;
      readkey;
    end;

    const
      PathToDriver = 'c:\bp\bgi';       (* change if necessary !!! *)

    var
      grDriver: Integer;
      grMode  : Integer;
      ErrCode : Integer;

    begin
      grDriver:= Detect;
      InitGraph(grDriver, grMode, PathToDriver);
      ErrCode:= GraphResult;
      if ErrCode <> grOk then
        Writeln('Graphics error:', GraphErrorMsg(ErrCode)) else
      begin
        DoGraphics;
        CloseGraph;
      end;
    end.

[Back to OOP SWAG index] [Back to Main SWAG index] [Original]