Программная модель взаимного качения квадрата и эллипса по плоской поверхности

{ 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 {перебираем все точки}

If elps.line[i].y>Gdisp Then {если точка оказалась ниже поверхности качения}

    if Round(elps.line[i].x)>OsXE then Begin {если координата х этой точки отличается от текужей х координаты оси вращения эллипса}

              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) {если точка внутри квадрата}

      Then If i<>nom then {то если ее номер отличается от текущего номера}

              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;

 

Procedure   TScreen.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 ); {вращаем квадрат}

     until not ShiftOsXY; {пока вращение не пройдет без необходимости сместить ось вращения}

  sides0:=sqre.Sides; {запоминаем положение обеих фигур}

  line0:=elps.line;

  Repeat

Rotateall( OsXE, OsYE, step1 ); {вращаем обе фигуры}

  until not ShiftOsXYE; {пока вращение не пройдет без смещения оси вращения}

    Sqre.Show  ( Sqre.Scolor, Image1 ); {прорисовываем фигуры}

     Elps.Show (Elps.Ecolor,image1); image1.Refresh;

    If OsXE > Image1.Width then {если дошли до края окна, то инициализируем сцену заново}

   Init ( Sqre.ss, Elps.Ecolor, Sqre.Scolor, Gcolor, Gdisp,image1 );                                

{Until False;}

End;

 

Destructor  TScreen.Done;

Begin End;

{---------------------------------------------------------------}

end.

 

 

Результаты моделирования  программы на ЭВМ

В результате выполнения программы на экране отображается следующее:

Изменяя константы можно  изменять параметры фигур, такие  как размеры, скорость движения, детализация и т.д.

 

Вывод

Разработанная программа  работает адекватно заданию. Изменение констант позволяет легко преобразовать программу для отображения взаимного качения квадрата и любого другого многоугольника, который можно вписать в окружность или эллипс. Сравнительно несложная доработка программы позволит создать модель качения этих фигур по неровной поверхности. Таким образом, Объектно-ориентированное программирование позволяет эффективно использовать наработки предыдущих программ для дальнейшего проектирования. Оно значительно упрощает процесс создания объемной программы путем разбиения ее на небольшие части, что очень удобно не только при программировании графики.

 

Литература

1. Гафаров Р.М. Методические указания для выполнения курсовых и лабораторных работ по теме «Объектно-ориентированное программирование» для студентов 1-2 курсов спец. 2201.

2. Мартынюк Т. Турбо  Паскаль 7.0. Самоучитель. – СПб.:  Питер; К.: Издательская группа BHV, 2002. – 416 с.: ил.

3. Павловская Т.А. Паскаль.  Программирование на языке высокого  уровня: Учебник для ВУЗов –  СПб.: Питер, 2004. – 393 с.: ил.