|
Описание объектов удобно поместить в отдельный модуль
SQUnit,
который может быть подключен к разрабатываемой программе.
Unit
SQUnit;
INTERFACE
Const
kv =
4; { кол-во
вершин
квадрата
}
speed
= 1.5; { коэфф. скорости перемещения квадрата }
one
= pi/180;
{ 1 градус в радианах }
step
= one*speed;
{ приращение угла поворота }
ms
= 2000; { величина задержки при анимации }
Type TPoint = Object
x,y
:Real; { координаты
точки
}
Pcolor
:Byte; { ее цвет }
Constructor Init
( xx,yy :Real; col :Byte );
Procedure Rotate
( xOs,yOs :Integer ); Virtual;
Procedure Show
( col :Byte ); 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 :Integer ); Virtual;
Procedure Show
( col :Byte ); 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 :Integer ); Virtual;
Procedure Show (
col :Byte ); Virtual;
Destructor Done;
End;
TScreen = Object ( TSquare ) {
О-тип
- сцена
};
Gdisp
:Integer;
{ эффективное
Y-смещение
поверхности качения}
Gcolor
:Byte;
{ цвет поверхности}
angle
:Real;
{ угол поворота квадрата}
OsX,OsY
:Integer;
{ текущее значения координат оси вращения }
Constructor Init ( aa, colK, colG
:Byte; dG :Integer );
Procedure
GraphInit; Virtual;
Function
ShiftOsXY :Boolean; Virtual;
Procedure
Go; Virtual;
Procedure
DrawGround; Virtual;
Destructor Done;
End;
IMPLEMENTATION
Uses Crt, Graph;
(********
Методы
TPoint
********************)
Constructor TPoint .Init (
xx, yy :Real; col :Byte );
Begin x:=xx; y:=yy; Pcolor
:= col; End;
{---------------------------------------------------------------}
Procedure TPoint .Rotate (
xOs,yOs :Integer );
Var xx, yy :Real;
Begin xx := (x - xOs)*Cos(step) -
(y - yOs)*Sin(step) + xOs;
yy := (x - xOs)*Sin
(step) + (y - yOs)*Cos(step) + yOs;
x :=xx; y:=yy;
End;
{---------------------------------------------------------------}
Procedure TPoint .Show (
col :Byte );
Begin PutPixel ( Round(x),
Round(y), Pcolor ); End;
{---------------------------------------------------------------}
Destructor TPoint .Done;
Begin End;
(******** Методы TLine
********************)
Constructor TLine .Init (
x1,y1,x2,y2 :Real; col :Byte );
Begin pn.Init(x1,y1,col);
pk.Init(x2,y2,col); Lcolor:=col; End;
{---------------------------------------------------------------}
Procedure TLine .Rotate (
xOs,yOs :Integer );
Begin pn.Rotate( xOs,yOs );
pk.Rotate( xOs,yOs ); End;
{---------------------------------------------------------------}
Procedure TLine .Show (
col :Byte );
Begin If col=0 Then SetColor ( col
) Else SetColor ( Lcolor ) ;
Line(Round(pn.x),Round(pn.y),Round(pk.x),Round(pk.y));
End;
{---------------------------------------------------------------}
Destructor TLine .Done;
Begin End;
(***************** Методы
TSquare ****************************)
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 :Integer );
{ реализует вращение квадрата путем поворота
каждой из его сторон}
Var i
:Byte;
{вокруг
оси
}
Begin For i:=0 To kv-1 Do Sides[i]
.Rotate ( xOs,yOs ); End;
{----------------------------------------------------------------}
Procedure TSquare .Show( col
:Byte ); { рисует(стирает)
изображение
}
Var i :Byte;
{квадрата
}
Begin For i := 0 To kv-1 Do
Sides[i].Show ( col ); End;
{----------------------------------------------------------------}
Destructor TSquare .Done;
Begin End;
(***************** Методы
TScreen ******************************)
Constructor TScreen .Init (
aa, colK, colG :Byte; dG :Integer );
Var
i
:Byte;
Begin
GraphInit;
{ инициализация графического режима
VGAHi
}
Inherited
Init
( aa,
colK
); { инициализация родителя }
Gdisp
:= dG;
{ задание Y-смещения
поверхности качения }
For i := 0 To kv-1 Do With
Sides[i] Do Begin {перенос
квадрата
на
pn.y := pn.y + Gdisp -
as; {
поверхность
качения}
pk.y := pk.y + Gdisp - as;
End;
Gcolor
:= colG;
{ задание цвета поверхности качения }
OsX
:= as;
OsY
:= Gdisp;
{ задание начальных координат оси вращения }
angle
:= 0; { задание начального значения угла поворота
}
DrawGround;
{ рисование поверхности качения }
End;
{---------------------------------------------------------------}
Procedure
TScreen
.GraphInit;{
инициализация графич. режима
VGAHi
}
Var gd, gm, ErrorCode :Integer;
Begin
If
GetGraphMode
= 2 Then
Exit;{
если графич. режим включен, то выход }
gd := Detect;
InitGraph ( gd, gm, '');
ErrorCode := GraphResult;
If ErrorCode <> grOk Then Begin
Writeln('Ошибка графики:',
GraphErrorMsg ( ErrorCode ) );
Halt(1);
End;
End;
{---------------------------------------------------------------}
Procedure TScreen .DrawGround;
{ рисование
поверхности
качения
}
Begin SetColor ( Gcolor );
Line ( 0, Round( Gdisp + 1 ),
GetMaxX, Round( Gdisp + 1 ) );
End;
{---------------------------------------------------------------}
Function TScreen .ShiftOsXY
:Boolean;
{опред-т момент и реализует смещение оси
вращения квадрата по оси
X}
Begin
If
angle
> pi/2
{ если наступил момент переноса оси поворота, }
Then
Begin OsX
:= OsX
+ as;
{ то сместить ось по
X
на
as}
ShiftOsXY := True; End
Else ShiftOsXY := False;
End;
{----------------------------------------------------------------------}
Procedure TScreen .Go; {реализует
движение
квадрата
и
анимацию
его}
Begin
{изображения}
Repeat
{ цикл возобновления сцены }
Repeat
{ цикл качения по поверхности и анимации }
angle
:= angle
+ step;
{ накопление угла поворота}
If
ShiftOsXY
{ если была смена оси
вращения, то пропустить }
Then Begin angle:=0; Continue;
End; {
вращение
и
анимацию
}
Rotate
( OsX,
OsY
); { вращение квадрата вокруг текущей оси }
Show(Scolor);
{ рисует изображение квадрата }
Delay(
ms
); { задержка }
Show(0);
{ стирает изображение квадрата }
If
KeyPressed
Then
Exit;
{ если клавиша нажата, то выход из процедуры}
Until
OsX
> GetMaxX;
{ если квадрат достиг правого края экрана, то }
Init ( as, Scolor, Gcolor, Gdisp
); { возобновление
сцены
}
DrawGround; { рисование поверхности качения
}
Until
False;
{ повторение работы до нажатия любой клавиши }
End;
{----------------------------------------------------------------------}
Destructor TScreen .Done;
Begin CloseGraph;
End; {закрытие
графического
режима
}
{----------------------------------------------------------------------}
End.
{конец модуля
SQUnit}
{*********** Головная программа ***************************}
Program
Primer_OOP;
Uses
SqUnit;
{ подключение модуля с описанием объектов }
Const
sizeSq
= 80; { размер квадрата }
colorSq
= 12; { и его цвет
}
colorG
= 2; { цвет поверхности качения }
deltaG
= 400; { смещение по
Y
поверхности качения на экране}
Var
Screen :TScreen;
Begin
Screen .Init ( sizeSq, colorSq, colorG, deltaG ); {инициализация}
Screen
.DrawGround;
{ прорисовка поверхности качения }
Screen
.Go; { качение
квадрата }
Screen
.Done; &nbs |
Главная
Каталог файлов
