Найти ошибку в программе перемещения круга

@NewMan · Регистрация: 11.12.2015

Author24 — интернет-сервис помощи студентам

В центре графического окна рисуется красный круг. Используя клавиши управления курсором (вправо, влево, вверх, вниз), можно перемещать этот круг по графическому окну. При этом круг не должен выходить за пределы окна.C помощью клавиши ‘+’ (VK_Add) можно увеличивать размер круга, а с помощью клавиши ‘-’ (VK_Subtract) уменьшать его. При этом круг не должен становиться больше высоты графического окна (выходить за его границы) и меньше минимального размера. Минимальный размер круга и величина, на которую он изменяет свой размер, задаются в программе константами.
Вот то,что у меня получилось:

Pascal

Program Romb;
Uses GraphABC;
const 
  minR=5;  
  Delta=5;
Var
   R, WW, WH, X, Y : Integer;
Procedure KeyDown(Key: Integer);
var RNew:integer;
Begin
  RNew:=R;
  Case Key Of
    VK_Add:
      If (X+R+Delta < WindowWidth) And (Y+R+Delta < WindowHeight)  Then
        RNew := R + Delta;
    VK_Subtract:
      If (R-Delta >= minR) Then 
        RNew := R - Delta;
      End;
  if R<>RNew then begin    
     SetPenColor(clWhite);
     SetBrushColor(clWhite);
     Circle(X, Y, R);
     R:=RNew;
     SetPenColor(clRed);
     SetBrushColor(clRed);
     Circle(X, Y, R);
  end;   
End;  
 Procedure KeyDown2(Key2: Integer);
Begin
   SetPenColor(clWhite);
   SetBrushColor(clWhite);
   Circle(X, Y, R);
   Case Key2 of
      VK_Up:
         If Y >= R + Delta Then
            Y := Y - Delta;
      VK_Right:
         If X <= WW - (R + Delta) Then
            X := X + Delta;
      VK_Down:
         If Y <= WH - (R + Delta) Then
            Y := Y + Delta;
      VK_Left:
         If X >= R + Delta Then
            X := X - Delta;
   End;
   SetPenColor(clRed);
   SetBrushColor(clRed);
   Circle(X, Y, R);
End;
 
Begin
   CenterWindow;
   WW := WindowWidth;
   WH := WindowHeight;
   X := WW div 2;
   Y := WH div 2;
   SetSmoothing(False);
   SetPenColor(clRed);
   SetBrushColor(clRed);
   R:=minR;
   Circle(X, Y, R);
   OnKeyDown := KeyDown;
    WW := WindowWidth;
   WH := WindowHeight;
   X := WW div 2;
   Y := WH div 2;
   SetSmoothing(False);
   SetPenColor(clRed);
   SetBrushColor(clRed);
   Circle(X, Y, R);
   OnKeyDown:= KeyDown2;
End.

С движением вроде бы всё норм,но размеры почему-то не работают(хотя в отдельной программе всё функционирует).

@nikhrom · 08.02.2016, 20:10

Pascal

program Romb;
 
uses
  GraphABC;
 
const
  minR = 5;  
  Delta = 5;
 
var
  R, WW, WH, X, Y: Integer;
 
procedure KeyDown(Key: Integer);
var
  RNew: integer;
begin
  SetPenColor(clWhite);
  SetBrushColor(clWhite);
  Circle(X, Y, R);
  RNew := R;
  case Key of
    VK_Up:
      if Y >= R + Delta Then
        Y := Y - Delta;
    VK_Right:
      if X <= WW - (R + Delta) Then
        X := X + Delta;
    VK_Down:
      if Y <= WH - (R + Delta) Then
        Y := Y + Delta;
    VK_Left:
      if X >= R + Delta Then
        X := X - Delta;
    VK_Add:
      //Проверим все 4 стороны круга
      if (X + R + Delta < WindowWidth) AND (X - R - Delta > 0) AND (Y + R + Delta < WindowHeight) AND (Y - R - Delta > 0) Then
        RNew := R + Delta;
    VK_Subtract:
      if (R - Delta >= minR) Then 
        RNew := R - Delta;
  End;
  if R <> RNew then
    R := RNew;
  SetPenColor(clRed);
  SetBrushColor(clRed);
  Circle(X, Y, R);
  Redraw
end;
 
begin
  LockDrawing;
  CenterWindow;
  WW := WindowWidth;
  WH := WindowHeight;
  X := WW div 2;
  Y := WH div 2;
  SetSmoothing(False);
  SetPenColor(clRed);
  SetBrushColor(clRed);
  R := minR;
  Circle(X, Y, R);
  Redraw;
  //Событию присваивается ТОЛЬКО ОДНА процедура
  OnKeyDown := KeyDown;
end.

@NewMan · 08.02.2016, 22:06 **[ТС]**

nikhrom, понятно,спасибо.

@nikhrom · 08.02.2016, 22:29

@NewMan 0 / 0 / 1 Регистрация: 11.12.2015 Сообщений: 18
	08.02.2016, 22:06 [ТС]	3
	nikhrom, понятно,спасибо. 0

@nikhrom 20 / 20 / 16 Регистрация: 21.01.2015 Сообщений: 51
	08.02.2016, 22:29	4
	0

Найти ошибку в программе перемещения круга

Решение