Алгоритм программы
Б
Стираем все объекты
Запоминаем
положениеквадрата
Поворачиваем
квадрат вокруг его оси вращения
Какая-либо точка
эллипса попала внутрь квадрата
Смещаем ось
вращения квадрата
Нет
Запоминаем
положение обоих фигур
Ось вращения
эллипса за пределами окна
Заново инициализируем
сцену
Да
Нет
Конец
Начало
Да
Восстанавливаем
предыдущее положение
лок-схема
основной процедуры программыTScreen.go:
Да
Восстанавливаем
предыдущее положение квадрата
Прорисовываем
фигуры
Поворачиваем обе
фигуры вокруг оси вращения эллипса
Какая-либо точка
эллипса оказалась ниже поверхности
Смещаем ось
вращения эллипса
Текст программы
program Lab;
uses
Forms,
Kurspas in 'Kurspas.pas' {Form1},
ElSq in 'ElSq.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
unit Kurspas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ElSq;
Const
sizeSq = 100; { размер квадрата }
colorEl = clBlue; {цвет эллипса}
colorSq=clYellow; { цвет квадрата }
colorG = ClGreen; { цвет поверхности качения }
type {описание формы}
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
Var screen: TScreen; {определение объекта типа TScreen}
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); {при нажатии кнопки Go}
begin
timer1.Enabled:=true; {активировать таймер}
end;
procedure TForm1.Button2Click(Sender: TObject); {при нажатии кнопки Exit}
begin
screen.Done; {вызвать деструктор}
Close; {завершить выполнение приложения}
end;
procedure TForm1.Timer1Timer(Sender: TObject); {при срабатывании таймера}
begin
Screen.Go; {запустить процедуру анимации экрана}
end;
procedure TForm1.FormCreate(Sender: TObject); {при запуске приложения}
begin
Screen.Init(sizeSq, colorEl, colorSq, colorG, Image1.height-30,Image1 );
{инициализировать объект Screen}
end;
procedure TForm1.Button3Click(Sender: TObject); {при нажатии кнопки Stop}
begin
timer1.Enabled:=false; {остановить таймер}
end;
end.
unit ElSq;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
Const
det= 36; {количество вершин для построения эллипса}
xrad= 40; {горизонтальный радиус эллипса}
yrad= 25; {вертикальный радиус эллипса}
kv= 4; {количество сторон квадрата}
speed1 = 0.9; {скорость вращения эллипса}
speed= 1.5; {скорость вращения квадрата}
one=pi/180; {один градус в радинах}
step=one*speed; {шаг поворота квадрата}
step1 =one*speed1; {шаг поворота эллипса}
Type TPoint = Object {О-тип точка}
x,y:Real; {координаты точки}
Pcolor :Byte; {цвет точки}
Constructor Init ( xx,yy :Real; col :Byte );
Procedure Rotate ( xOs, yOs, spd :real ); Virtual;
Procedure Show ( col :Byte; var image1:TImage ); Virtual;
Destructor Done;
End;
TSide = array [1..det] of TPoint; {тип для описания вершин эллипса}
TEllipse=Object ( TPoint ) {О-тип эллипс}
line :TSide; {вершины эллипса}
EColor :Byte; {его цвет}
Constructor init (colE :byte);
procedure Rotate (xOsE, yOsE, spd:real); Virtual;
Procedure Show (col:Byte; var image1:TImage); Virtual;
Destructor Done;
end;
TLine = Object ( TPoint ) {О-тип отрезок}
pn,pk:TPoint; {начальная и конечная точки отрезка}
Lcolor :Byte; {его цвет}
Constructor Init ( x1,y1,x2,y2 :Real; col :Byte );
Procedure Rotate ( xOs, yOs, spd :real ); Virtual;
Procedure Show ( col :Byte; var image1:TImage ); Virtual;
Destructor Done;
End;
TSides = Array [ 0..kv-1 ] Of TLine; {тип для описания сторон квадрата}
TSquare = Object ( TLine ) {О-тип квадрат}
as:Byte; {длина стороны квадрата}
Sides:TSides; {стороны квадрата}
Scolor:Byte; {его цвет}
Constructor Init ( aa, colK :Byte );
Procedure Rotate ( xOs, yOs, spd :real ); Virtual;
Procedure Show ( col :Byte; var image1:TImage ); Virtual;
Destructor Done;
End;
TScreen = Object ( TEllipse ) {О-тип сцена}
image1 :TImage; {адрес картинки}
Elps :TEllipse; {эллипс}
Sqre :Tsquare; {квадрат}
Gdisp:Integer; {смещение поверхности качения}
Gcolor:TColor; {цвет поверхности качения}
line0 :TSide; {переменные для запоминание текущего положения фигур}
sides0 :TSides;
OsXE,OsYE,nom:Integer; {переменные для хранения координат осей вращения}
Constructor Init ( aa:Byte; colE, colK, colG :TColor; dG :Integer; var image:TImage );
Function ShiftOsXY :Boolean; Virtual;
Function ShiftOsXYE :Boolean;
Procedure CalcABC( Var S1,S2 :TLine; Var A,B,C :Real );
Function Dist( A,B,C, xx,yy :Real) :Real;
Procedure Rotateall(xOs,yOs:Integer; spd:real);
Procedure Go; Virtual;
Procedure DrawGround; Virtual;
Destructor Done;
End;
{TForm2 = class(TForm)
private }
{ Private declarations}
{ public }
{ Public declarations }
{ end;
var
Form2: TForm2;}
implementation
{---------------------------------------------------------------}
Constructor TPoint .Init ( xx, yy :Real; col :TColor );
Begin x:=xx; y:=yy; Pcolor := col; End;
Procedure TPoint .Rotate ( xOs,yOs :Integer; spd:real );
Var xx, yy :Real;
Begin xx := (x - xOs)*Cos(spd) - (y - yOs)*Sin(spd) + xOs;
yy := (x - xOs)*Sin (spd) + (y - yOs)*Cos(spd) + yOs;
x :=xx; y:=yy;
End;
Procedure TPoint .Show ;
Begin
Image1.Canvas.pixels[Round(x),Round(y)]:=col;
End;
Destructor TPoint .Done;
Begin End;
{---------------------------------------------------------------}
Constructor TLine .Init ( x1,y1,x2,y2 :Real; col :TColor );
Begin pn.Init(x1,y1,col); pk.Init(x2,y2,col); Lcolor:=col; End;
Procedure TLine .Rotate ( xOs,yOs :Integer; spd:real );
Begin pn.Rotate( xOs,yOs,spd ); pk.Rotate( xOs,yOs,spd ); End;
Procedure TLine .Show ;
Begin If col=clWhite Then image1.canvas.pen.color:= col Else image1.canvas.pen.color:= Lcolor;
image1.Canvas.MoveTo(Round(pn.x),Round(pn.y));
image1.canvas.LineTo(Round(pk.x),Round(pk.y));
End;
Destructor TLine .Done;
Begin End;
{---------------------------------------------------------------}
Constructor TEllipse.init(colE:byte); {инициализация эллипса}
var i:byte;
px,py:real;
Begin
EColor:=colE;
for i:=1 to det do begin
px:=xrad*cos((i-1)*2*pi/det); {определение координат точек}
py:=yrad*sin((i-1)*2*pi/det);
with line[i] do init(px,py,colE);
end;
end;
Procedure TEllipse.rotate(xOsE, yOsE, spd :real ); {вращение эллипса}
Var i:byte;
begin
for i:=1 to det do line[i].rotate(xOsE,yOsE,spd); {вращение каждой точки}
end; {эллипса}
procedure TEllipse.Show; {процедура отображения (стирания)}
var i:byte; {эллипса}
begin image1.Canvas.Pen.Color:=col; {установка цвета эллипса}
image1.canvas.moveto(Round(line[1].x),round(line[1].y));{помещение текущего указателя в первую вершину эллипса}
for i:=det downto 1 do
with line[i] do image1.canvas.lineto(round(x),round(y));{прорисовка эллипса по точкам}
end;
destructor TEllipse.done;
begin end;
{---------------------------------------------------------------}
Constructor TSquare .Init ( aa, colK :Byte ); {инициализация квадрата}
Begin
as:=aa; {установка размера стороны квадрата}
Sides[0]. Init ( as, as, 0, as, colK ); {инициализация сторон квадрата}
Sides[1]. Init ( 0, as, 0, 0, colK );
Sides[2]. Init ( 0, 0, as, 0, colK );
Sides[3]. Init ( as, 0, as, as, colK );
Scolor := colK;
End;
Procedure TSquare .Rotate ( xOs, yOs, spd:real ); {вращение квадрата}
Var i :Byte;
Begin
For i:=0 To kv-1 Do Sides[i] .Rotate ( xOs,yOs,spd );
End;
Procedure TSquare .Show; {отображение(стирание) квадрата}
Var i :Byte;
Begin For i := 0 To kv-1 Do Sides[i].Show ( col,image1 ); End;
Destructor TSquare .Done;
Begin End;
{---------------------------------------------------------------}
Constructor TScreen .Init ( aa:Byte; colE, colK, colG :TColor; dG :Integer; var image:TImage );
Var i :Byte;
Begin
{закрашиваем экран белым}
image1:=image; {принимаем адрес нашего экрана для рисования}
image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style:=bsSolid;
image1.Canvas.FillRect(rect(0,0,image1.Width,image1.Height));
Sqre.Init ( aa, colK ); {инициализируем квадрат}
Elps.init(colE); {инициализируем эллипс}
Gdisp := dG;
For i := 0 To kv-1 Do With Sqre.Sides[i] Do Begin {ставим квадрат на эллипс}
pn.y := pn.y + Gdisp - Sqre.ss-2*yrad-1;
pk.y := pk.y + Gdisp - Sqre.ss-2*yrad-1;
pn.x := pn.x + xrad;
pk.x := pk.x + xrad;
End;
For i:=1 to Det do With Elps.line[i] do begin {ставим эллипс на поверхность}
y:=y+Gdisp-yrad;
x:=x+xrad; end;
Gcolor:=colG; {принимаем цвет поверхности}
nom:=det-1; {устанавливаем начальные значения координат осей вращения}
OsXE:= xrad;
OsYE:= Gdisp;
DrawGround;{рисуем поверхность}
End;
Procedure TScreen .DrawGround; {процедура прорисовки поверхности}
Begin Image1.canvas.pen.color:= Gcolor; {установка цвета прорисовки прямоугольника}
Image1.Canvas.Brush.Color:=Gcolor; {и цвета заливки}
image1.Canvas.MoveTo(0, Gdisp + 1); {прорисовка линий}
Image1.canvas.LineTo( Image1.Width, Gdisp + 1 );
Image1.Canvas.Brush.Style:=bsBDiagonal; {установка стиля заливки}
Image1.canvas.FloodFill(2,Gdisp+2,Gcolor, fsBorder); {заливка поверхности}
image1.Canvas.Refresh;
End;
Function TScreen .ShiftOsXYE :Boolean; {смещение оси вращения эллипса}
var i:byte;
Begin
ShiftOsXYE := False;
for i:=1 to det do {перебираем все точки}
Ifelps.line[i].y>GdispThen{если точка оказалась ниже поверхности качения}
ifRound(elps.line[i].x)>OsXEthenBegin{если координата х этой точки отличается от текужей х координаты оси вращения эллипса}
elps.line:=line0; {то восстанавливаем предыдущее положение фигур}
sqre.Sides:=sides0;
OsXE := Round(elps.line[i].x); {смещаем ось вращения}
ShiftOsXYE := True; End;
End;
{следующие 2 процедуры как в методичке, принцип действия объяснен в анализе алгоритма}
Procedure TScreen.CalcABC( Var S1,S2 :TLine; Var A,B,C :Real );
Var xn,yn,xk,yk :Real;
Begin xn := (S1.pn.x+S2.pk.x)/2; yn := (S1.pn.y+S2.pk.y)/2;
xk := (S1.pk.x+S2.pn.x)/2; yk := (S1.pk.y+S2.pn.y)/2;
A := yk - yn; B := xn - xk; C := xk * yn - xn * yk;
End;
Function TScreen.Dist( A,B,C, xx,yy :Real) :Real;
Begin Dist := Abs((A*xx+B*yy+C) / Sqrt(A*A+B*B)); End;
Function TScreen.ShiftOsXY :Boolean; {смещение оси вращения квадрата}
Var Ax, Bx, Cx, Ay, By, Cy, xx, yy :Real;
i :Integer;
Begin
ShiftOsXY := False;
{подсчет параметров новой системы координат}
CalcABC( Sqre.Sides[1], Sqre.Sides[3], Ax, Bx, Cx );
CalcABC( Sqre.Sides[0], Sqre.Sides[2], Ay, By, Cy );
For i := 1 To Det Do {перебор всех точек эллипса}
Begin
yy := Dist( Ay, By, Cy, Elps.line[i].x, Elps.line[i].y ); {подсчет координат точки в новой системе координат}
xx := Dist( Ax, Bx, Cx, Elps.line[i].x, Elps.line[i].y );
If ( xx <= Sqre.ss/2 ) and ( yy <= Sqre.ss/2) {если точка внутри квадрата}
ThenIfi<>nomthen{то если ее номер отличается от текущего номера}
Begin
nom:=i; {смещаем ось вращения}
ShiftOsXY := True;
sqre.Sides:=sides0; {восстанавливаем предыдущее положение квадрата}
Exit;
End;
End;
End;
Procedure TScreen.Rotateall(xOs,yOs:Integer; spd:real); {вращение всех фигур}
var xx,yy:real;
Begin Sqre.rotate(xOs,yOs,spd);
Elps.rotate(xOs,yOs,spd);
End;
ProcedureTScreen.Go; {продвижение на 1 кадр}
Begin
Sqre.Show ( clWhite,image1 ); {стираем фигуры}
Elps.show ( clWhite,image1 );
sides0:=sqre.Sides; {запоминаем положение квадрата}
repeat
sqre.Rotate ( Round(elps.line[nom].x), Round(elps.line[nom].y), step ); {вращаем квадрат}
untilnotShiftOsXY; {пока вращение не пройдет без необходимости сместить ось вращения}
sides0:=sqre.Sides; {запоминаем положение обеих фигур}
line0:=elps.line;
Repeat
Rotateall( OsXE, OsYE, step1 ); {вращаем обе фигуры}
untilnotShiftOsXYE; {пока вращение не пройдет без смещения оси вращения}
Sqre.Show(Sqre.Scolor,Image1 ); {прорисовываем фигуры}
Elps.Show (Elps.Ecolor,image1); image1.Refresh;
IfOsXE>Image1.Widththen{если дошли до края окна, то инициализируем сцену заново}
Init ( Sqre.ss, Elps.Ecolor, Sqre.Scolor, Gcolor, Gdisp,image1 );
{Until False;}
End;
Destructor TScreen.Done;
Begin End;
{---------------------------------------------------------------}
end.