Построение графических объектов прямоугольник, окружность и линия — Pascal(Паскаль)

uses graphapp;
var
app:tgraphapp;
begin
app.init;
app.run;
app.done;
end.

unit graphapp;

interface

uses graphobj;

const
  npoints = 100;

type
  tgraphapp = object
    points: array [1 .. npoints] of tpoint;
    line: tline;
    rect: trect;
    circ: tcircle;
    activeobj: integer;
    destructor done;
    constructor init;
    procedure run;
    procedure showall;
    procedure moveactiveobj(dx, dy: integer);
  end;

implementation

uses graph, crt;

constructor tgraphapp.init;
var
  d, r, err, k: integer;
begin
  d := detect;
  initgraph(d, r, 'c:\bp\bgi');
  err := graphresult;
  if err <> 0 then
  begin
    grapherrormsg(err);
    halt;
  end;
  setbkcolor(white);
  for k := 1 to npoints do
    points[k].init(random(getmaxx), random(getmaxy), random(15) + 1);
  line.init(getmaxx div 3, getmaxy div 3, 2 * getmaxx div 3,
    2 * getmaxy div 3, red);
  circ.init(getmaxx div 2, getmaxx div 2, getmaxy div 5, green);
  rect.init(2 * getmaxx div 5, 2 * getmaxy div 5, 3 * getmaxx div 5,
    3 * getmaxy div 5, blue);
  showall;
  activeobj := 1;
end;

procedure tgraphapp.run;
var
  stop: boolean;
const
  d = 5;
begin
  stop := false;
  repeat
    case readkey of
      #27:
        stop := true;
      #9:
        begin
          inc(activeobj);
          if activeobj > 3 then
            activeobj := 1;
        end;
      #0:
        case readkey of
          #71:
            moveactiveobj(-d, -d);
          #72:
            moveactiveobj(0, -d);
          #73:
            moveactiveobj(d, -d);
          #75:
            moveactiveobj(-d, 0);
          #77:
            moveactiveobj(d, 0);
          #79:
            moveactiveobj(-d, d);
          #80:
            moveactiveobj(0, d);
          #81:
            moveactiveobj(d, d);
        end;
    end;
    showall;
  until stop;
end;

destructor tgraphapp.done;
begin
  closegraph;
end;

procedure tgraphapp.showall;
var
  k: integer;
begin
  for k := 1 to npoints do
    points[k].show;
  line.show;
  rect.show;
  circ.show;
end;

procedure tgraphapp.moveactiveobj;
begin
  case activeobj of
    1:
      rect.moveto(dx, dy);
    2:
      circ.moveto(dx, dy);
    3:
      line.moveto(dx, dy);
  end;
end;

end.

unit graphobj;

interface

type
  tgraphobj = object
  private
    x, y: integer;
    color: word;
  public
    constructor init(ax, ay: integer; acolor: word);
    procedure draw(acolor: word); virtual;
    procedure show;
    procedure hide;
    procedure moveto(dx, dy: integer);
  end;

type
  tpoint = object(tgraphobj)
    procedure draw(acolor: word); virtual;
  end;

type
  tline = object(tgraphobj)
    dx, dy: integer;
    constructor init(x1, y1, x2, y2: integer; acolor: word);
    procedure draw(acolor: word); virtual;
  end;

type
  tcircle = object(tgraphobj)
    r: integer;
    constructor init(ax, ay, ar: integer; acolor: word);
    procedure draw(acolor: word); virtual;
  end;

type
  trect = object(tline)
    procedure draw(acolor: word); virtual;
  end;

implementation

uses crt, graph;

constructor tgraphobj.init;
begin
  x := ax;
  y := ay;
  color := acolor;
end;

procedure tgraphobj.draw;
begin
end;

procedure tgraphobj.show;
begin
  draw(color);
end;

procedure tgraphobj.hide;
begin
  draw(getbkcolor);
end;

procedure tgraphobj.moveto;
begin
  hide;
  x := x + dx;
  y := y + dy;
  show;
end;

procedure tpoint.draw;
begin
  putpixel(x, y, color);
end;

constructor tline.init;
begin
  inherited init(x1, y1, acolor);
  dx := x2 - x1;
  dy := y2 - y1;
end;

procedure tline.draw;
begin
  setcolor(acolor);
  line(x, y, x + dx, y + dy);
end;

constructor tcircle.init;
begin
  inherited init(ax, ay, acolor);
  r := ar;
end;

procedure tcircle.draw;
begin
  setcolor(acolor);
  circle(x, y, r);
end;

procedure trect.draw;
begin
  setcolor(acolor);
  rectangle(x, y, x + dx, y + dy);
end;

end.