4 Исходный код программы

unit MainFm;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ActnList, Menus, Ball, XPMan, ComCtrls;

type

TMainForm = class(TForm)

WorkAreaPanel: TPanel;

LabMainMenu: TMainMenu;

FileMenuItem: TMenuItem;

ExitMenuItem: TMenuItem;

ParamMenuItem: TMenuItem;

AboutMenuItem: TMenuItem;

RestartMenuItem: TMenuItem;

ActionList1: TActionList;

ExitAction: TAction;

RestartAction: TAction;

AboutAction: TAction;

ManageGroupBox: TGroupBox;

RestartButton: TButton;

AnimateTimer: TTimer;

PauseButton: TButton;

XPManifest1: TXPManifest;

PauseAction: TAction;

PauseItem: TMenuItem;

SpeedEdit: TEdit;

SpeedUpDown: TUpDown;

RadiusEdit: TEdit;

RadiusUpDown: TUpDown;

AngleLabel: TLabel;

RadiusLabel: TLabel;

HideControlPanelAction: TAction;

HideControlPanelMenuItem: TMenuItem;

ButtonGroupBox: TGroupBox;

BallGroupBox: TGroupBox;

SurfaceGroupBox: TGroupBox;

AutoGenerateCheckBox: TCheckBox;

FirstSinLabel: TLabel;

FirstSinMEdit: TEdit;

FirstSinPiShiftEdit: TEdit;

OperationEdit: TEdit;

SecondSinMEdit: TEdit;

SecondSinLabel: TLabel;

SecondSinPiShiftEdit: TEdit;

Label1: TLabel;

AnglePiLabel: TLabel;

AngleEdit: TEdit;

RandomAngleCheckBox: TCheckBox;

FirstSinDividerEdit: TEdit;

SecondSinDividerEdit: TEdit;

procedure AboutActionExecute(Sender: TObject);

procedure RestartActionExecute(Sender: TObject);

procedure ExitActionExecute(Sender: TObject);

procedure AnimateTimerTimer(Sender: TObject);

procedure PauseButtonClick(Sender: TObject);

procedure FormPaint(Sender: TObject);

procedure PauseActionExecute(Sender: TObject);

procedure SpeedUpDownClick(Sender: TObject; Button: TUDBtnType);

procedure SpeedEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure RadiusUpDownClick(Sender: TObject; Button: TUDBtnType);

procedure RadiusEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure HideControlPanelActionExecute(Sender: TObject);

procedure WorkAreaPanelResize(Sender: TObject);

procedure AutoGenerateCheckBoxClick(Sender: TObject);

procedure RandomAngleCheckBoxClick(Sender: TObject);

private

FBallVisualController: TBallVisualController;

// Начать заново.

procedure Restart;

end;

var

MainForm: TMainForm;

implementation

uses Math;

{$R *.dfm}

const

MAX_START_SPEED = 100;

type

EWrongOperation = class(Exception);

procedure TMainForm.AboutActionExecute(Sender: TObject);

const

ABOUT_MESSAGE = 'Программу разработал в 2011 г.' + sLineBreak +

'студент гр. М01-784-1 - Полин А.Ю.' + sLineBreak +

'(Объекто-ориентированная реализация)';

begin

ShowMessage(ABOUT_MESSAGE);

end;

procedure TMainForm.RestartActionExecute(Sender: TObject);

begin

Restart;

end;

procedure TMainForm.ExitActionExecute(Sender: TObject);

begin

Close;

end;

procedure TMainForm.AnimateTimerTimer(Sender: TObject);

begin

AnimateTimer.Enabled := False;

FBallVisualController.Iterate;

AnimateTimer.Enabled := True;

end;

procedure TMainForm.PauseButtonClick(Sender: TObject);

begin

AnimateTimer.Enabled := False;

end;

procedure TMainForm.FormPaint(Sender: TObject);

begin

if Assigned(FBallVisualController) then

FBallVisualController.Draw;

end;

procedure TMainForm.PauseActionExecute(Sender: TObject);

const

PAUSE_CAPTION = 'Пауза';

PLAY_CAPTION = 'Возобновить';

begin

AnimateTimer.Enabled := not AnimateTimer.Enabled;

if AnimateTimer.Enabled then

PauseAction.Caption := PAUSE_CAPTION

else

PauseAction.Caption := PLAY_CAPTION;

end;

procedure TMainForm.SpeedUpDownClick(Sender: TObject; Button: TUDBtnType);

begin

SpeedEdit.Text := FloatToStr(SpeedUpDown.Position / 10);

end;

procedure TMainForm.SpeedEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

const

HIGH_SPEED_MESSAGE = 'К сожалению, скорость мяча не может быть более %d м/c';

var

Value: Double;

begin

if Key = VK_RETURN then

try

Value := StrToFloat(SpeedEdit.Text);

if Value < 0 then

SpeedEdit.Text := '0'

else

if Value > MAX_START_SPEED then

begin

SpeedEdit.Text := FloatToStr(MAX_START_SPEED);

ShowMessage(Format(HIGH_SPEED_MESSAGE, [MAX_START_SPEED]));

end;

SpeedUpDown.Position := Round(StrToFloat(SpeedEdit.Text) * 10);

except

SpeedEdit.Text := FloatToStr(SpeedUpDown.Position / 10);

end;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

SpeedUpDown.Max := MAX_START_SPEED * 10;

WorkAreaPanel.DoubleBuffered := True;

WorkAreaPanel.ControlStyle := WorkAreaPanel.ControlStyle + [ csOpaque ];

end;

procedure TMainForm.RadiusUpDownClick(Sender: TObject;

Button: TUDBtnType);

begin

RadiusEdit.Text := FloatToStr(RadiusUpDown.Position / 10);

end;

procedure TMainForm.Restart;

const

PAUSE_CAPTION = 'Пауза';

OPERATION_MINUS = '-';

OPERATION_PLUS = '+';

E_CONVERT_ERROR = '''%s'' не является вещественным значением';

var

Buffer: String;

WrongFloatValue: String;

begin

try

if not Assigned(FBallVisualController) then

FBallVisualController := TBallVisualController.Create(WorkAreaPanel);

PauseAction.Enabled := True;

PauseAction.Caption := PAUSE_CAPTION;

AnimateTimer.Enabled := False;

FBallVisualController.BallPhysicController.BallDefaultZeroSpeed :=

SpeedUpDown.Position / 10;

FBallVisualController.BallPhysicController.Ball.Radius :=

RadiusUpDown.Position * 10;

if not AutoGenerateCheckBox.Checked then

with FBallVisualController.BallPhysicController.SurfaceGenerationParams do

begin

FirstSinusoidMultiplier := StrToFloat(FirstSinMEdit.Text);

FirstSinusoidPIShift := StrToFloat(FirstSinPiShiftEdit.Text);

FirstSinusoidDivider := StrToFloat(FirstSinDividerEdit.Text);

SecondSinusoidMultiplier := StrToFloat(SecondSinMEdit.Text);

SecondSinusoidPIShift := StrToFloat(SecondSinPiShiftEdit.Text);

SecondSinusoidDivider := StrToFloat(SecondSinDividerEdit.Text);

if Trim(OperationEdit.Text) = OPERATION_PLUS then

SinOperation := 1

else

if Trim(OperationEdit.Text) = OPERATION_MINUS then

SinOperation := -1

else

raise EWrongOperation.Create('Операция может быть только + или -');

end;

if not RandomAngleCheckBox.Checked then

FBallVisualController.BallPhysicController.Alpha := Pi / StrToFloat(AngleEdit.Text);

FBallVisualController.Restart(WorkAreaPanel.ClientWidth, WorkAreaPanel.ClientHeight,

AutoGenerateCheckBox.Checked, RandomAngleCheckBox.Checked);

if AutoGenerateCheckBox.Checked then

with FBallVisualController.BallPhysicController.SurfaceGenerationParams do

begin

FirstSinMEdit.Text := FloatToStr(FirstSinusoidMultiplier);

FirstSinPiShiftEdit.Text := FloatToStr(FirstSinusoidPIShift);

FirstSinDividerEdit.Text := FloatToStr(FirstSinusoidDivider);

SecondSinMEdit.Text := FloatToStr(SecondSinusoidMultiplier);

SecondSinPiShiftEdit.Text := FloatToStr(SecondSinusoidPIShift);

SecondSinDividerEdit.Text := FloatToStr(SecondSinusoidDivider);

case SinOperation of

-1:

OperationEdit.Text := OPERATION_MINUS;

1:

OperationEdit.Text := OPERATION_PLUS;

end;

end;

if RandomAngleCheckBox.Checked then

AngleEdit.Text := FloatToStr(Pi / FBallVisualController.BallPhysicController.Alpha);

AnimateTimer.Enabled := True;

except

on E: EConvertError do

begin

Buffer := Copy(E.Message, 2, Length(E.Message) - 1);

WrongFloatValue := Copy(Buffer, 1, Pos('''', Buffer) - 1);

ShowMessage(Format(E_CONVERT_ERROR, [WrongFloatValue]));

end;

on E: EWrongOperation do

ShowMessage(E.Message);

end;

end;

procedure TMainForm.RadiusEditKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

var

Value: Double;

begin

if Key = VK_RETURN then

try

Value := StrToFloat(RadiusEdit.Text);

if Value < 0 then

RadiusEdit.Text := '0'

else

if Value > 0.5 then

RadiusEdit.Text := '0.5';

RadiusUpDown.Position := Round(StrToFloat(RadiusEdit.Text) * 10);

except

RadiusEdit.Text := FloatToStr(RadiusUpDown.Position / 10);

end;

end;

procedure TMainForm.HideControlPanelActionExecute(Sender: TObject);

const

HIDE_ACTION_CAPTION = 'Скрыть панель управления';

SHOW_ACTION_CAPTION = 'Показать панель управления';

begin

ManageGroupBox.Visible := not ManageGroupBox.Visible;

case ManageGroupBox.Visible of

True:

HideControlPanelAction.Caption := HIDE_ACTION_CAPTION;

False:

HideControlPanelAction.Caption := SHOW_ACTION_CAPTION;

end;

end;

procedure TMainForm.WorkAreaPanelResize(Sender: TObject);

begin

if Assigned(FBallVisualController) then

FBallVisualController.ResizeBox(WorkAreaPanel.ClientWidth, WorkAreaPanel.ClientHeight);

end;

procedure TMainForm.AutoGenerateCheckBoxClick(Sender: TObject);

begin

FirstSinMEdit.Enabled := not FirstSinMEdit.Enabled;

FirstSinPiShiftEdit.Enabled := not FirstSinPiShiftEdit.Enabled;

OperationEdit.Enabled := not OperationEdit.Enabled;

SecondSinMEdit.Enabled := not SecondSinMEdit.Enabled;

SecondSinPiShiftEdit.Enabled := not SecondSinPiShiftEdit.Enabled;

FirstSinLabel.Enabled := not FirstSinLabel.Enabled;

SecondSinLabel.Enabled := not SecondSinLabel.Enabled;

FirstSinDividerEdit.Enabled := not FirstSinDividerEdit.Enabled;

SecondSinDividerEdit.Enabled := not SecondSinDividerEdit.Enabled;

end;

procedure TMainForm.RandomAngleCheckBoxClick(Sender: TObject);

begin

AnglePiLabel.Enabled := not AngleLabel.Enabled;

AngleEdit.Enabled := not AngleEdit.Enabled;

end;

end.

unit Ball;

interface

uses

Windows, Graphics, Controls;

type

// Мяч.

TBall = class

private

FRadius: Double;

FX: Double;

FY: Double;

FSpeed: Double;

function GetRect: TRect;

public

// Координата X центра.

property X: Double read FX write FX;

// Координата Y центра.

property Y: Double read FY write FY;

// Радиус.

property Radius: Double read FRadius write FRadius;

// Скорость.

property Speed: Double read FSpeed write FSpeed;

// Область, описанная вокруг мяча.

property Rect: TRect read GetRect;

end;

// Поверхность.

TSurface = array of TPoint;

// Параметры генерации поверхности из двух синусоид.

TSurfaceGenerationParams = record

// Множитель первой синусоиды.

FirstSinusoidMultiplier: Double;

// Множитель второй синусоиды.

SecondSinusoidMultiplier: Double;

// Делитель аргумента первой синусоиды.

FirstSinusoidDivider: Double;

// Делитель аргумента второй синусоиды.

SecondSinusoidDivider: Double;

// Делитель смещения первой синусоиды.

FirstSinusoidPIShift: Double;

// Делитель смещения второй синусоиды.

SecondSinusoidPIShift: Double;

// Операция применяемая над синусоидами.

SinOperation: Integer;

// Минимальное значение координаты Y в точках поверхности.

SurfaceMinY: Integer;

end;

// Тип соприкосновения с поверхностью.

TContactType = (

// С левой стороной коробки.

ctBoxLeft,

// С правой стороной коробки.

ctBoxRight,

// С верхом коробки.

ctBoxTop,

// С дном коробки.

ctBoxBottom,

// С поверхностью.

ctSurface);

// Контролер физического поведения мяча.

TBallPhysicController = class

private

// Мяч.

FBall: TBall;

// Поверхность.

FSurface: TSurface;

// Ширина коробки.

FBoxWidth: Integer;

// Высота коробки.

FBoxHeight: Integer;

// Текущий момент времени для расчета параболы.

FTimeMoment: Double;

// Угол альфа для расчета параболы.

FAlpha: Double;

// Предыдущее значение координаты X мяча.

FBallPreviousX: Double;

// Предыдущее значение координаты Y мяча.

FBallPreviousY: Double;

// 0 значение координаты X движения по параболе.

FBallZeroPointX: Double;

// 0 значение координаты Y движения по параболе.

FBallZeroPointY: Double;

// Скорость в 0 точке.

FBallZeroSpeed: Double;

// Скорость в 0 точке при рестарте.

FBallDefaultZeroSpeed: Double;

// Параметры генерации поверхности.

FSurfaceGenerationParams: TSurfaceGenerationParams;

// Cгенерировать поверхность.

procedure GenerateSurface;

// Сгенерировать случайные параметры поверхности.

procedure GenerateRandomSurfaceParams;

// Вычислить минимальное значение Y синусоиды поверхности.

procedure CalculateSurfaceMinY;

// Проверить соприкосновение с поверхностью и коробкой.

procedure CheckContact;

// Вычислить угол альфа при отскоке.

procedure CalculateAlpha(

// Тип соприкосновения.

const AContactType: TContactType;

// Индекс точки поверхности.

const ASurfacePointIndex: Integer = 0);

public

property Ball: TBall read FBall;

property Surface: TSurface read FSurface;

property BallDefaultZeroSpeed: Double read FBallDefaultZeroSpeed

write FBallDefaultZeroSpeed;

property SurfaceGenerationParams: TSurfaceGenerationParams

read FSurfaceGenerationParams;

property Alpha: Double read FAlpha write FAlpha;

// Изменить размер коробки.

procedure ResizeBox(

// Ширина коробки.

const ABoxWidth: Integer;

// Высота коробки.

const ABoxHeight: Integer);

// Начать заново.

procedure Restart(

// Ширина коробки.

const ABoxWidth: Integer;

// Высота коробки.

const ABoxHeight: Integer;

// Автоматически генерировать поверхность.

const AIsAutoGeneratedSurface: Boolean;

// Случайный угол падения мяча.

const AIsRandomAngle: Boolean);

// Выполнить итерацию.

procedure Iterate;

// Конструктор.

constructor Create;

// Деструктор.

destructor Destroy; override;

end;

// Контроллер отрисовки мяча.

TBallVisualController = class

private

// Контролер физического поведения мяча.

FBallPhysicController: TBallPhysicController;

// Окно на котором идет отрисовка.

FWindow: TWinControl;

// Высота коробки.

FBoxHeight: Integer;

// Ширина коробки.

FBoxWidth: Integer;

// Задний план.

FBackground: TBitmap;

// Инвертировать координату Y точки.

function Invert(APoint: TPoint): TPoint;

// Инвертировать координаты Y области.

function InvertRect(ARect: TRect): TRect;

// Сгенерировать задний план.

procedure GenerateBackground;

public

// Отрисовать.

procedure Draw;

// Изменить размер коробки.

procedure ResizeBox(

// Ширина коробки.

const ABoxWidth: Integer;

// Высота коробки.

const ABoxHeight: Integer);

// Начать заново.

procedure Restart(

// Ширина коробки.

const ABoxWidth: Integer;

// Высота коробки.

const ABoxHeight: Integer;

// Автоматически генерировать поверхность.

const AIsAutoGeneratedSurface: Boolean;

// Случайный угол падения мяча.

const AIsRandomAngle: Boolean);

// Конструктор.

constructor Create(

// Окно на котором идет отрисовка.

const AWindow: TWinControl);

// Деструктор.

destructor Destroy; override;

// Выполнить итерацию.

procedure Iterate;

// Контролер физического поведения мяча.

property BallPhysicController: TBallPhysicController read

FBallPhysicController;

end;

implementation

uses

Math, VectoryAlgebra, Types, SysUtils, Classes;

{ TBallPhysicController }

procedure TBallPhysicController.CalculateAlpha(

const AContactType: TContactType; const ASurfacePointIndex: Integer);

var

ContactPoint, PreviousPointMove, Perpendicular: TVector2R;

BufferAlpha, Teta, AxisDifferenceAngle: Double;

begin

// Определить точку контакта.

case AContactType of

ctBoxLeft:

ContactPoint := AddVect2R(Vector2R(FBall.X, FBall.Y), Vector2R(- FBall.Radius, 0));

ctBoxRight:

ContactPoint := AddVect2R(Vector2R(FBall.X, FBall.Y), Vector2R(FBall.Radius, 0));

ctBoxTop:

ContactPoint := AddVect2R(Vector2R(FBall.X, FBall.Y), Vector2R(0, FBall.Radius));

ctBoxBottom:

ContactPoint := AddVect2R(Vector2R(FBall.X, FBall.Y), Vector2R(0, - FBall.Radius));

ctSurface:

ContactPoint := Vector2R(FSurface[ASurfacePointIndex].X, FSurface[ASurfacePointIndex].Y);

end;

PreviousPointMove := SubVect2R(Vector2R(FBallPreviousX, FBallPreviousY),

Vector2R(FBall.X, FBall.Y));

Perpendicular := RightPerpendicularVector2R(SubVect2R(Vector2R(FBall.X, FBall.Y), ContactPoint));

BufferAlpha := AngelFromVectorToVector(Perpendicular, PreviousPointMove);

Teta := Pi - BufferAlpha;

AxisDifferenceAngle := AngelFromVectorToVector2Pi(Vector2R(1, 0), Perpendicular);

FAlpha := Teta + AxisDifferenceAngle;

FBallZeroSpeed := FBall.Speed;

FTimeMoment := 0;

FBallZeroPointX := FBall.X;

FBallZeroPointY := FBall.Y;

end;

procedure TBallPhysicController.CalculateSurfaceMinY;

var

I, CalculatedValue: Integer;

begin

with FSurfaceGenerationParams do

begin

SurfaceMinY := High(Integer);

// Минимальное значение функции встречается на [0; 2Pi].

for I := 0 to 628 do

begin

CalculatedValue := Round((FirstSinusoidMultiplier * Sin(I / FirstSinusoidDivider) -

pi / FirstSinusoidPIShift) + SinOperation * (SecondSinusoidMultiplier *

Sin(I / SecondSinusoidDivider) + pi / SecondSinusoidPIShift));

if CalculatedValue < SurfaceMinY then

SurfaceMinY := CalculatedValue;

end;

SurfaceMinY := Abs(SurfaceMinY) + 10;

end;

end;

procedure TBallPhysicController.CheckContact;

var

I, MinSurfaceDistanceIndex: Integer;

MinSurfaceDistance, Distance: Double;

begin

// Проверить касание коробки.

if (FBall.Rect.Left <= 0) and (FBall.X <= FBallPreviousX) then

CalculateAlpha(ctBoxLeft)

else

if (FBall.Rect.Right >= FBoxWidth) and (FBall.X >= FBallPreviousX) then

CalculateAlpha(ctBoxRight)

else

if (FBall.Rect.Top >= FBoxHeight) and (FBall.Y >= FBallPreviousY) then

CalculateAlpha(ctBoxTop)

else

if (FBall.Rect.Bottom <= 0) and (FBall.Y <= FBallPreviousY) then

CalculateAlpha(ctBoxBottom)

else

begin

// Проверить касание поверхности.

MinSurfaceDistance := 1.7e308;

MinSurfaceDistanceIndex := -1;

for I := 0 to Length(FSurface) - 1 do

begin

Distance := DistBetweenPoints2R(Vector2R(FSurface[I].X, FSurface[I].Y),

Vector2R(FBall.X, FBall.Y));

if Distance < MinSurfaceDistance then

begin

MinSurfaceDistance := Distance;

MinSurfaceDistanceIndex := I;

end;

end;

if (MinSurfaceDistanceIndex <> -1) and (MinSurfaceDistance <= FBall.Radius) and

(MinSurfaceDistance < DistBetweenPoints2R(Vector2R(FSurface[MinSurfaceDistanceIndex].X,

FSurface[MinSurfaceDistanceIndex].Y), Vector2R(FBallPreviousX, FBallPreviousY))) then

CalculateAlpha(ctSurface, MinSurfaceDistanceIndex);

end;

end;

constructor TBallPhysicController.Create;

begin

inherited Create;

FBall := TBall.Create;

FBall.FRadius := 20.0;

FBallDefaultZeroSpeed := 0;

end;

destructor TBallPhysicController.Destroy;

begin

SetLength(FSurface, 0);

FBall.Free;

inherited;

end;

procedure TBallPhysicController.GenerateRandomSurfaceParams;

begin

with FSurfaceGenerationParams do

begin

Randomize;

FirstSinusoidMultiplier := 25 * (Random(5) + 1);

SecondSinusoidMultiplier := 15 * (Random(3) + 1);

FirstSinusoidDivider := 100;

SecondSinusoidDivider := 50;

FirstSinusoidPIShift := Random(3) + 1;

SecondSinusoidPIShift := Random(6) + 1;

SinOperation := Random(2) - 1;

if SinOperation = 0 then

Inc(SinOperation);

end;

end;

procedure TBallPhysicController.GenerateSurface;

var

I: Integer;

begin

SetLength(FSurface, 0);

SetLength(FSurface, FBoxWidth);

with FSurfaceGenerationParams do

begin

for I := 0 to FBoxWidth - 1 do

begin

FSurface[I].X := I;

// Сложить 2 синуосоиды.

FSurface[I].Y := Round(

(FirstSinusoidMultiplier * Sin(I / FirstSinusoidDivider) - pi / FirstSinusoidPIShift) +

SinOperation * (SecondSinusoidMultiplier * Sin(I/ SecondSinusoidDivider) +

pi / SecondSinusoidPIShift));

end;

// Необходимо поднять поверхность, чтобы она отображалась целиком.

for I := 0 to FBoxWidth - 1 do

FSurface[I].Y := FSurface[I].Y + Abs(SurfaceMinY);

end;

end;

procedure TBallPhysicController.Iterate;

var

I: Integer;

IterateCount: Integer;

begin

if FBall.Speed > 1 then

IterateCount := Round(FBall.Speed) + 10

else

IterateCount := 1;

for I := 1 to IterateCount do

begin

FTimeMoment := FTimeMoment + 0.01 / IterateCount;

FBallPreviousX := FBall.X;

FBallPreviousY := FBall.Y;

FBall.X := FBallZeroPointX + Cos(FAlpha) * FBallZeroSpeed * FTimeMoment * 100;

FBall.Y := FBallZeroPointY + (Sin(FAlpha) * FBallZeroSpeed * FTimeMoment -

4.9 * Sqr(FTimeMoment)) * 100;

FBall.Speed := Sqrt(Sqr(FBallZeroSpeed * Cos(FAlpha)) +

Sqr(FBallZeroSpeed * Sin(FAlpha) - 9.8 * FTimeMoment));

CheckContact;

end;

end;

procedure TBallPhysicController.ResizeBox(const ABoxWidth,

ABoxHeight: Integer);

begin

FBoxWidth := ABoxWidth;

FBoxHeight := ABoxHeight;

GenerateSurface;

end;

procedure TBallPhysicController.Restart(const ABoxWidth,

ABoxHeight: Integer; const AIsAutoGeneratedSurface,

AIsRandomAngle: Boolean);

var

RandomAnglePart: Integer;

begin

FBoxWidth := ABoxWidth;

FBoxHeight := ABoxHeight;

if AIsAutoGeneratedSurface then

GenerateRandomSurfaceParams;

CalculateSurfaceMinY;

GenerateSurface;

FBall.X := FBoxWidth / 2;

FBall.Y := FBoxHeight / 4 * 3;

FBall.Speed := 0;

FBallPreviousX := FBall.X;

FBallPreviousY := FBall.Y;

FBallZeroPointX := FBall.X;

FBallZeroPointY := FBall.Y;

FBallZeroSpeed := FBallDefaultZeroSpeed;

FTimeMoment := 0;

if AIsRandomAngle then

begin

Randomize;

RandomAnglePart := Random(11) - 5;

if InRange (RandomAnglePart, -1, 1) then

RandomAnglePart := - 3;

FAlpha := pi / RandomAnglePart;

end;

end;

{ TBallVisualController }

constructor TBallVisualController.Create(

const AWindow: TWinControl);

begin

inherited Create;

FWindow := AWindow;

FBallPhysicController := TBallPhysicController.Create;

end;

procedure TBallVisualController.Draw;

var

BufferBitmap: TBitmap;

DC: HDC;

begin

BufferBitmap := TBitmap.Create;

try

BufferBitmap.Width := FBoxWidth;

BufferBitmap.Height := FBoxHeight;

if Assigned(FBackground) then

BitBlt(BufferBitmap.Canvas.Handle, 0, 0, FBoxWidth, FBoxHeight,

FBackground.Canvas.Handle, 0, 0, SRCCOPY);

if Assigned(FBallPhysicController) then

with BufferBitmap.Canvas do

begin

Pen.Color := clBlue;

Brush.Color := clBlue;

Ellipse(InvertRect(FBallPhysicController.Ball.Rect));

end;

DC := GetWindowDC(FWindow.Handle);

try

BitBlt(DC, 0, 0, FBoxWidth, FBoxHeight,

BufferBitmap.Canvas.Handle, 0, 0, SRCCOPY);

finally

ReleaseDC(FWindow.Handle, DC);

end;

finally

BufferBitmap.Free;

end;

end;

function TBallVisualController.InvertRect(ARect: TRect): TRect;

begin

Result := ARect;

Result.TopLeft.Y := FBoxHeight - Result.TopLeft.Y;

Result.BottomRight.Y := FBoxHeight - Result.BottomRight.Y;

end;

function TBallVisualController.Invert(APoint: TPoint): TPoint;

begin

Result.X := APoint.X;

Result.Y := FBoxHeight - APoint.Y;

end;

procedure TBallVisualController.Iterate;

begin

FBallPhysicController.Iterate;

Draw;

end;

procedure TBallVisualController.Restart(const ABoxWidth,

ABoxHeight: Integer; const AIsAutoGeneratedSurface,

AIsRandomAngle: Boolean);

begin

FBallPhysicController.Restart(ABoxWidth, ABoxHeight,

AIsAutoGeneratedSurface, AIsRandomAngle);

FBoxHeight := ABoxHeight;

FBoxWidth := ABoxWidth;

GenerateBackground;

Draw;

end;

procedure TBallVisualController.GenerateBackground;

var

DrawableSurface: array of TPoint;

I: Integer;

begin

if not Assigned(FBackground) then

FBackGround := TBitmap.Create;

FBackground.Width := FBoxWidth;

FBackground.Height := FBoxHeight;

SetLength(DrawableSurface, Length(FBallPhysicController.Surface) + 2);

try

for I := 0 to Length(FBallPhysicController.Surface) - 1 do

DrawableSurface[I] := Invert(FBallPhysicController.Surface[I]);

DrawableSurface[Length(FBallPhysicController.Surface)].X := FBoxWidth;

DrawableSurface[Length(FBallPhysicController.Surface)].Y := FBoxHeight;

DrawableSurface[Length(FBallPhysicController.Surface) + 1].X := 0;

DrawableSurface[Length(FBallPhysicController.Surface) + 1].Y := FBoxHeight;

with FBackground.Canvas do

begin

Pen.Color := clRed;

Brush.Color := clWhite;

Rectangle(FWindow.ClientRect);

Brush.Color := clRed;

Polygon(DrawableSurface);

end;

finally

SetLength(DrawableSurface, 0);

end;

end;

destructor TBallVisualController.Destroy;

begin

if Assigned(FBackGround) then

FBackground.Free;

FBallPhysicController.Free;

inherited;

end;

procedure TBallVisualController.ResizeBox(const ABoxWidth,

ABoxHeight: Integer);

begin

FBallPhysicController.ResizeBox(ABoxWidth, ABoxHeight);

FBoxHeight := ABoxHeight;

FBoxWidth := ABoxWidth;

GenerateBackground;

end;

{ TBall }

function TBall.GetRect: TRect;

begin

Result.TopLeft.X := Round(FX - FRadius);

Result.TopLeft.Y := Round(FY + FRadius);

Result.BottomRight.X := Round(FX + FRadius);

Result.BottomRight.Y := Round(FY - FRadius);

end;

end.