Показать сообщение отдельно
Старый 05.04.2012, 10:31   #6 (permalink)
alexpauk
Новичок
 
Регистрация: 03.04.2012
Сообщений: 6
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Помогите разобраться в ещё одной программкой.

uses graphABC;
type tochka=record
x,y:integer;
u,r:real;
end;
bukva=array[1..20] of tochka;
{угол между лучем и осью Х}
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{вертикально вниз}
{else Ugol:=0{центр координат, здесь не нужно}
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,k:integer;var a:bukva);
var i:integer;
begin
for i:=1 to n do
begin
a[i].u:=a[i].u+0.1;
a[i].x:=x0+round(k*a[i].r*cos(a[i].u));
a[i].y:=y0-round(a[i].r*sin(a[i].u));
end;
end;

{расширение и сжатие фигуры}
procedure Rash(x0,y0,n:integer;k:real;var a:bukva);
var i:integer;
begin
for i:=1 to n do
begin
a[i].r:=a[i].r*k;
a[i].x:=x0+round(a[i].r*cos(a[i].u));
a[i].y:=y0-round(a[i].r*sin(a[i].u));
end;
end;
{буква А}
procedure AA(x,y:integer;a:bukva;c:Color);
begin
setpencolor(c);
line(a[1].x,a[1].y,a[3].x,a[3].y);
line(a[3].x,a[3].y,a[5].x,a[5].y);
line(a[2].x,a[2].y,a[4].x,a[4].y);
end;
{буква Б}
procedure BB(x,y:integer;a:bukva;c:Color);
begin
setpencolor(c);
line(a[1].x,a[1].y,a[3].x,a[3].y);
line(a[3].x,a[3].y,a[4].x,a[4].y);
line(a[2].x,a[2].y,a[5].x,a[5].y);
line(a[5].x,a[5].y,a[6].x,a[6].y);
line(a[1].x,a[1].y,a[6].x,a[6].y);
end;
{буква И}
procedure II(x,y:integer;a:bukva;c:Color);
begin
setpencolor(c);
line(a[1].x,a[1].y,a[2].x,a[2].y);
line(a[1].x,a[1].y,a[3].x,a[3].y);
line(a[3].x,a[3].y,a[4].x,a[4].y);
end;
var a,b,c:bukva;
x1,x2,x3,y1,i,d:integer;
u,k:real;
begin
x1:=windowwidth div 4;
y1:=windowheight div 2;
d:=x1 div 4;
a[1].x:=x1-d;a[1].y:=y1+d;
a[3].x:=x1;a[3].y:=y1-d;
a[5].x:=x1+d;a[5].y:=y1+d;
a[2].x:=(a[1].x+a[3].x) div 2;
a[2].y:=(a[1].y+a[3].y) div 2;
a[4].x:=(a[5].x+a[3].x) div 2;
a[4].y:=a[2].y;
for i:=1 to 5 do
begin
a[i].r:=Radius(x1,y1,a[i].x,a[i].y);
a[i].u:=Ugol(x1,y1,a[i].x,a[i].y);
end;
x3:=windowwidth-x1;
c[1].x:=x3-d;c[1].y:=y1+d;
c[2].x:=x3-d;c[2].y:=y1-d;
c[3].x:=x3+d;c[3].y:=y1-d;
c[4].x:=x3+d;c[4].y:=y1+d;
for i:=1 to 4 do
begin
c[i].r:=Radius(x3,y1,c[i].x,c[i].y);
c[i].u:=Ugol(x3,y1,c[i].x,c[i].y);
end;
x2:=2*x1;
b[1].x:=x2-d;b[1].y:=y1+d;
b[2].x:=x2-d;b[2].y:=y1;
b[3].x:=x2-d;b[3].y:=y1-d;
b[4].x:=x2+d;b[4].y:=y1-d;
b[5].x:=x2+d;b[5].y:=y1;
b[6].x:=x2+d;b[6].y:=y1+d;
for i:=1 to 6 do
begin
b[i].r:=Radius(x2,y1,b[i].x,b[i].y);
b[i].u:=Ugol(x2,y1,b[i].x,b[i].y);
end;
AA(x1,y1,a,clRed);
BB(x2,y1,b,clBlue);
II(x3,y1,c,clGreen);
k:=1.1;
u:=0;
lockdrawing;
repeat
clearwindow;
Vrach(x1,y1,5,-1,a);
Vrach(x3,y1,4,1,c);
Rash(x2,y1,6,k,b);
if b[3].x<=x2-2*d then k:=0.9;
if b[3].x>=x2-d div 2 then k:=1.1;
AA(x1,y1,a,clRed);
BB(x2,y1,b,clBlue);
II(x3,y1,c,clGreen);
sleep(100);
redraw;
u:=u+0.1;
until u>100;
end.

Здесь меня интересует как задаются координаты буквы и как они изменяются. Пытался что-то сделать - ничего нормального не получилось.
alexpauk вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070