Реализовать линейное перемещение и вращение вокруг какой-либо точки графического объекта - PascalABC.NET

Узнай цену своей работы

Формулировка задачи:

Здравствуйте, пожалуйста помогите с задачкой. Вот её содержание: Реализовать линейное перемещение и вращение вокруг какой-либо точки графического объекта, координаты точек для построения многоугольника считываются с внешнего файла, как и координаты точки вокруг которой осуществляется вращение. (координаты задавать самим) (Данная тема - результат объединения кросспостов из веток PascalABC.NET и Turbo Pascal)

Решение задачи: «Реализовать линейное перемещение и вращение вокруг какой-либо точки графического объекта»

textual
Листинг программы
uses graphABC;
type mng=record//тип запись с полями 
         kr:array of Point;//координаты вершин
         u,r:array of real;//углы луча из центра к точке с осью Х и радиусы вращения
         end;
var f:boolean;//переменная для выхода из программы     
//вычисление угла между лучом и осью Х
function Ugol(x0,y0,x,y:integer):real;
begin
if (x>x0)and(y<=y0) then Ugol:=arctan((y0-y)/(x-x0))//I четверть
else if (x>x0)and(y>y0) then Ugol:=arctan((y0-y)/(x-x0))+2*pi//IV четверть
else if x<x0 then  Ugol:=arctan((y0-y)/(x-x0))+pi//II-III четверти
else if x=x0 then
 begin
  if y<y0 then  Ugol:=pi/2//вертикально вверх
  else if y>y0 then Ugol:=3*pi/2//вертикально вниз
 end;
end;
//вычисление радиуса вращения=расстояние от точки до центра
//параметры координаты центра и точки
function Radius(x1,y1,x2,y2:integer):real;
begin
Radius:=sqrt(sqr(x1-x2)+sqr(y1-y2));
end;
//вращение точки вокруг центра
//параметры координаты центра, количество вершин, приращение угла, массив точек
procedure Vrach(x0,y0,n:integer;k:real;var a:mng);
var i:integer;
begin
for i:=0 to n-1 do//для всех точек
 begin
  a.u[i]:=a.u[i]+k;//наращиваем угол
  a.kr[i].x:=x0+round(a.r[i]*cos(a.u[i]));//вычисляем новые координаты
  a.kr[i].y:=y0-round(a.r[i]*sin(a.u[i]));
 end;
end;
//рисование многоугольника
procedure ris(a:mng);
begin
Pen.Color:=clRed;//цвет линий
Brush.Color:=clWhite;
Pen.Width:=3;//толщина линий
Polygon(a.kr);
end;
//процедура нажатия клавиши
procedure KeyDown(Key: integer);
begin
if Key=VK_Return then f:=false;//если нажата Enter-меняем значение флага
end;
//основная программа
var  t:text;
     a:mng;//многоугольник
     n,i,x,y,x0,y0,x1,max,min,x2,x3:integer; 
     k:real;
begin
Setwindowsize(500,500);
Window.Center;
x1:=Window.Width div 2;
f:=true;//программа включена на работу
assign(t,'koordinaty.txt');//файл в папке с программой
reset(t);
read(t,n);//прочитаем количество вершин
n:=n+1;//добавим точку для замыкания полигона
setlength(a.kr,n);//выделим память под массивы
setlength(a.u,n);
setlength(a.r,n);
for i:=0 to n-2 do//прочитаем координаты вершин
 begin
  read(t,x,y);
  a.kr[i].x:=x;
  a.kr[i].y:=y;
 end; 
read(t,x0,y0);//прочитаем координаты точки вращения
close(t);
a.kr[n-1]:=a.kr[0];//замкнем полигон
min:=a.kr[0].x;//найдем правую и левую точки
max:=a.kr[0].x;
for i:=0 to n-1 do//а также радиусы и углы
 begin
  if a.kr[i].x<min then min:=a.kr[i].x;
  if a.kr[i].x>max then max:=a.kr[i].x;
 end;
x2:=min;
x3:=max; 
lockdrawing;//Блокирует рисование графических объектов. 
            //Возможна лишь перерисовка всего экрана вызовом Redraw 
while (x3<=windowwidth)and f do//едем вправо
 begin
  Window.Clear;//очищаем экран
  ris(a);//рисуем в исходных координатах
  textout(x1-50,10,'Выход Enter');//выводим сообщение как выйти из программы
  sleep(10);//задержка на 0,01 секунды
  for i:=0 to n-1 do//все точки сдвигаем вправо
  a.kr[i].x:=a.kr[i].x+2;
  inc(x3,2);
  inc(x2,2);
  redraw;//перерисовываем
  OnKeyDown := KeyDown;//если нажмем Enter, сменится флаг на false
 end;
while (x2>0)and f do//едем влево
 begin
  Window.Clear;
  ris(a);//рисуем в исходных координатах
  textout(x1-50,10,'Выход Enter');//выводим сообщение как выйти из программы
  sleep(10);//задержка на 0,01 секунды
  for i:=0 to n-1 do//все точки сдвигаем влево
  a.kr[i].x:=a.kr[i].x-2;
  dec(x2,2);
  redraw;//перерисовываем
  OnKeyDown := KeyDown;//если нажмем Enter, сменится флаг на false
 end; 
//встаем в центр и вычисляем углы и радиусы с точкой вращения
for i:=0 to n-1 do
 begin
  a.kr[i].x :=x1+a.kr[i].x-(max-min) div 2;
  a.r[i]:=Radius(x0,y0,a.kr[i].x,a.kr[i].y);
  a.u[i]:=Ugol(x0,y0,a.kr[i].x,a.kr[i].y);
 end; 
sleep(500);
Window.Clear;
ris(a);
redraw;
OnKeyDown := KeyDown;
k:=0.1;
repeat
Window.Clear;
Vrach(x0,y0,n,k,a);//поворачиваем фигуру
Brush.Color:=clBlue;
Pen.Color:=clBlue;
circle(x0,y0,3);//рисуем точку поворота
ris(a);//рисуем фигуру
textout(x1-50,10,'Выход Enter');
sleep(100);//задержка на 0,1 секунды
redraw;//перерисовываем
OnKeyDown := KeyDown;//если нажмем Enter, сменится флаг на false
until not f;//и программа завершится}
end.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4 из 5
Похожие ответы