Pascal графика

uses crt, graph;

type

  TFigure = object
    enabled: Boolean;
    constructor Create;
    destructor Done;
    procedure   Show; virtual;
    procedure   Refresh;
  end;

  PTCircle = ^TCircle;

  TCircle = object(TFigure)
     cx, cy, r: Word;
    constructor Create(centrX, centrY, radius: Word);
    procedure   Show; virtual;
  end;


  PTRectangle = ^TRectangle;

  TRectangle = object(TFigure)
    lx, ly, rx, ry: Word;
    constructor Create(leftX, leftY, rightX, rightY: Word);
    procedure   Show; virtual;
  end;

  PTTriangle = ^TTriangle;

  TTriangle = object(TFigure)
     cx, cy, v: Word;
    constructor Create(centrX, centrY, volume: Word);
    procedure Show; virtual;
  end;

constructor TFigure.Create;
begin end;

destructor TFigure.Done;
begin end;

procedure TFigure.Show;
begin end;

procedure TFigure.Refresh;
begin enabled := not(enabled);
end;

constructor TCircle.Create(centrX, centrY, radius: Word);
begin
  inherited Create;
  cx := centrX;
  cy := centrY;
  r := radius;
  enabled := false;
end;

procedure TCircle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Circle(cx, cy, r);
end;

constructor TRectangle.Create(leftX, leftY, rightX, rightY: Word);
begin
  inherited Create;
  lx := leftX;
  ly := leftY;
  rx := rightX;
  ry := rightY;
end;

procedure TRectangle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Rectangle(lx, ly, rx, ry);
end;

constructor TTriangle.Create(centrX, centrY, volume: Word);
begin
  inherited Create;
  cx := centrX;
  cy := centrY;
  v  := volume;
end;

procedure TTriangle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Line(cx - v, cy - v, cx + v, cy - v); { top}
  Line(cx + v, cy - v, cx, cy + v);     { left}
  Line(cx - v, cy - v, cx, cy + v);    { right }
end;

procedure OpenGraph;
var
  gd, gm: integer;
begin

  gd := detect;
  InitGraph(gd, gm, '');
  if GraphResult <> grOk then Halt(1);
end;

var
  F: array [1..6] of ^TFigure;
  i: Integer;
  ch: char;
begin

  OpenGraph;

  F[1] := new(PTTriangle, Create(200, 200, 50));
  F[2] := new(PTcircle, Create(20, 20, 20));
  F[3] := new(PTRectangle, Create(300, 300, 350, 350));
  F[4] := new(PTRectangle, Create(500, 500, 550, 550));
  F[5] := new(PTCircle, Create(300, 100, 40));
  F[6] := new(PTTriangle, Create(110, 500, 100));

  ch := #0;

  repeat
    while keypressed do ch := readkey;
    case ch of
     'T', 't': for i := 1 to 6 do begin if (typeof(F^) = typeof(TTriangle)) then F^.Refresh; end;
     'R', 'r': for i := 1 to 6 do begin if (typeof(F^) = typeof(TRectangle)) then F^.Refresh; end;
     'C', 'c': for i := 1 to 6 do begin if (typeof(F^) = typeof(TCircle)) then F^.Refresh; end;
    end;
    for i := 1 to 6 do F^.Show;
    Delay(100);
  until ch = #27;
end.

uses crt, graph;

type
  PTFigure = ^TFigure;
  TFigure = object
    enabled: Boolean;

    constructor Create;
    destructor Done;
    procedure   Show; virtual;
    procedure   Refresh;
  end;

  PTCircle = ^TCircle;
  TCircle = object(TFigure)
    cx, cy, r: Word;

    constructor Create(centrX, centrY, radius: Word);
    procedure   Show; virtual;
  end;

  PTRectangle = ^TRectangle;
  TRectangle = object(TFigure)
    lx, ly, rx, ry: Word;

    constructor Create(leftX, leftY, rightX, rightY: Word);
    procedure   Show; virtual;
  end;

  PTTriangle = ^TTriangle;
  TTriangle = object(TFigure)
    cx, cy, v: Word;

    constructor Create(centrX, centrY, volume: Word);
    procedure Show; virtual;
  end;

constructor TFigure.Create;
begin end;

destructor TFigure.Done;
begin end;

procedure TFigure.Show;
begin end;

procedure TFigure.Refresh;
begin enabled := not(enabled);
end;

constructor TCircle.Create(centrX, centrY, radius: Word);
begin
  inherited Create;
  cx := centrX;
  cy := centrY;
  r := radius;
  enabled := false;
end;

procedure TCircle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Circle(cx, cy, r);
end;

constructor TRectangle.Create(leftX, leftY, rightX, rightY: Word);
begin
  inherited Create;
  lx := leftX;
  ly := leftY;
  rx := rightX;
  ry := rightY;
end;

procedure TRectangle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Rectangle(lx, ly, rx, ry);
end;

constructor TTriangle.Create(centrX, centrY, volume: Word);
begin
  inherited Create;
  cx := centrX;
  cy := centrY;
  v  := volume;
end;

procedure TTriangle.Show;
begin
  if enabled then SetColor(Red) else SetColor(White);
  Line(cx - v, cy - v, cx + v, cy - v); { top   }
  Line(cx + v, cy - v, cx, cy + v);     { left  }
  Line(cx - v, cy - v, cx, cy + v);     { right }
end;

Type
  what = (_Circle, _Rectangle, _Triangle);
Var xPos: integer;

Function CreateFigure(F: what): PTFigure;
var the_result: PTFigure;
begin
  Case F of
    _Circle:
      the_result := new(PTCircle, Create(xPos, getmaxy div 2, 25));
    _Rectangle:
      the_result := new(PTRectangle, Create(xPos, getmaxy div 2 - 20,
                                            xPos + 25, getmaxy div 2 + 20));
    _Triangle:
      the_result := new(PTTriangle, Create(xPos, getmaxy div 2, 25));
  end;
  the_result^.show;
  inc(xPos, 60);
  CreateFigure := the_result;
end;

procedure OpenGraph;
var
  gd, gm: integer;
begin

  gd := detect;
  InitGraph(gd, gm, '');
  if GraphResult <> grOk then Halt(1);
end;

const
  size = 8;
var
  F: array [1 .. size] of PTFigure;
  i: Integer;
  ch: char;
begin

  OpenGraph;

  xPos := 50;
  Randomize;
  for i := 1 to size do begin
    readkey;
    F := CreateFigure(what(random(3)));
  end;

  ch := #0;
  outtextxy(50, getmaxy div 2 - 50, 'T = triangle / R = rectangle / C = circle');

  repeat
    while keypressed do ch := readkey;
    case ch of
     'T', 't': for i := 1 to size do begin if (typeof(F^) = typeof(TTriangle)) then F^.Refresh; end;
     'R', 'r': for i := 1 to size do begin if (typeof(F^) = typeof(TRectangle)) then F^.Refresh; end;
     'C', 'c': for i := 1 to size do begin if (typeof(F^) = typeof(TCircle)) then F^.Refresh; end;
    end;
    for i := 1 to size do F^.Show;
    Delay(100);
  until ch = #27;
end.