Реализовать линейное перемещение и вращение вокруг какой-либо точки графического объекта - 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.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д