Разработка Windows-приложения в среде Pascal ABC

var key : integer;

begin

   key:=Ord(ReadKey);

   if key=0 then key:=256 + Ord(ReadKey);

   RdKey:=key;

end;

// Описание класса TPoint

type TPoint = class

  x, y, color : integer;

  constructor Create(x0, y0, c0 : integer);

  procedure Show;

  procedure Hide;

  procedure Move(newx, newy : integer);

  procedure ChangeColor(newc : integer);

  procedure HandleEvent(key : integer);

end;

// конструктор класса

constructor TPoint.Create(x0, y0, c0 : integer);

begin

  x:=x0; y:=y0; color:=c0;

end;

// описание методов класса

procedure TPoint.Show;

begin

  SetPenColor(color);

  SetBrushColor(clWhite);

  Circle(x,y,2);

end;

// ------------------------------

procedure TPoint.Hide;

begin

  SetPenColor(clWhite);

  SetBrushColor(color);

  Circle(x,y,2);

end;

// ------------------------------

procedure TPoint.Move(newx, newy : integer);

begin

  Hide; x:=newx; y:=newy; Show;

end;

// ------------------------------

procedure TPoint.ChangeColor(newc : integer);

begin

  color:=newc;

  Show;

end;

// ------------------------------

procedure TPoint.HandleEvent(key : integer);

begin

  case key of

    Up    : Move(x, y-10);

    Down: Move(x, y+10);

    Left  : Move(x-10, y);

    Right : Move(x+10, y);

    Ord('0') : ChangeColor(clBlack);

    Ord('1') : ChangeColor(clBlue);

    Ord('2') : ChangeColor(clGreen);

    Ord('3') : ChangeColor(clTeal);

    Ord('4') : ChangeColor(clRed);

    Ord('5') : ChangeColor(clPurple);

    Ord('6') : ChangeColor(clBrown);

    Ord('7') : ChangeColor(clGray);

  end;

end;

// главная программа

// Описание класса TCircle

type TCircle = class(TPoint)

  R : integer;

  constructor Create(x0, y0, c0, R0 : integer);

  procedure Show;

  procedure Hide;

  procedure ChangeR(dR : integer);

  procedure HandleEvent(key : integer);

end;

// конструктор класса

constructor TCircle.Create(x0, y0, c0, R0 : integer);

begin

inherited Create(x0, y0, c0); // вызов конструктора  базового класса

  R:=R0;

end;

// описание методов класса

procedure TCircle.Show;

begin

  SetPenColor(color);

  SetBrushColor(clWhite);

  Circle(x, y, R);

end;

// ------------------------------

procedure TCircle.Hide;

begin

  SetPenColor(clWhite);

  SetBrushColor(color);

  Circle(x, y, R);

end;

// ------------------------------

procedure TCircle.ChangeR(dR : integer);

begin

  Hide;

  if R+dR>0 then R:=R+dR;

  Show;

end;

// ------------------------------

procedure TCircle.HandleEvent(key : integer);

begin

  case key of

   Ord('<') : ChangeR(-10);

   Ord('>') : ChangeR(10);

  else inherited HandleEvent(key);

  end;

end;

//создание нового класса

type TCrug=class(Tcircle)

  fi:real;

constructor Create(x0,y0,c0,R0:integer;fi0:real);

procedure Show;

procedure Hide;

procedure HandleEvent(key:integer);

procedure Ugol(dfi:real);

end;

constructor TCrug.Create(x0,y0,c0,R0:integer;fi0:real);

begin

inherited Create(x0, y0, c0, R0);

fi:=fi0;

end;

procedure TCrug.Show ;

var

x1,y1,x2,y2:integer;

  begin

  SetPenColor(color);

  x1:=x+round(R*cos(fi));

  y1:=y-round(R*sin(fi));

  x2:=x-round(R*cos(fi));

  y2:=y+round(R*sin(fi));

  Circle(x,y,R);

  Line(x1,y1,x2,y2)

  end;

procedure TCrug.Hide;

var

x1,y1,x2,y2:integer;

  begin

  SetPenColor(clWhite);

  x1:=x+round(R*cos(fi));

  y1:=y-round(R*sin(fi));

  x2:=x-round(R*cos(fi));

  y2:=y+round(R*sin(fi));

  Circle(x,y,R);

  Line(x1,y1,x2,y2)

  end;

procedure TCrug.Ugol(dfi:real);

  begin

  fi:=fi+dfi;

  Show

  end;

procedure TCrug.HandleEvent(key:integer);

begin

   case key of

   Ord('R') : Ugol(-0.1);

   Ord('L') : Ugol(0.1);

  else inherited HandleEvent(key);

  end;

end;

//Напишем главную программу

var

  key : integer;

  A : TCrug;

begin

  SetPenWidth(3);

  // создаем окружность

  A:=TCrug.Create(320, 240, clGreen, 40,0);

  // рисуем её на экране

  A.Show;

  // и управляем ее положением, размером и цветом

  repeat

    key:=RdKey;

    A.HandleEvent(key);

  until key=27;

end.