- •Лабораторная работа № 1 «Технология разработки по при структурном подходе»
- •3.2 Структурная схема по с пошаговой детализацией
- •3.3 Структуры данных
- •3.4 Пользовательский интерфейс
- •4 Исходный код программы
- •5 Вывод
- •4 Результаты тестирования
- •5 Вывод
- •3.2 Определение отношений между объектами
- •3.3 Проектирование классов
- •4 Исходный код программы
- •5 Вывод
- •4 Результаты тестирования
- •5 Вывод
3.4 Пользовательский интерфейс
Для программы был разработан интерфейс со свободной навигацией. На рисунке 3.4 приведен вид главной формы приложения.
Рисунок 3.4 – Главное окно приложения
В нижней части окна располагается панель управления, которую можно скрыть. Нажатие на кнопку рестарт приводит к прерыванию текущего движению и началу нового случайного. Нажатие на кнопку пауза приостанавливает движение.
На панели управления находится группа визуальных элементов, позволяющих задать параметры мяча – начальную скорость, радиус, а также начальный угол падения.
Также можно задать параметры генерации поверхности. Результирующая поверхность является результатом сложения или разности двух синусоид, параметры которых также можно задать. Это позволяет создать достаточно сложную поверхность (см. рисунок 3.5).
Рисунок 3.5 – Произвольная поверхность
Скрыть и восстановить панель управления можно из главного меню приложения.
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
FDrawInited: Boolean;
// Начать заново.
procedure Restart;
end;
var
MainForm: TMainForm;
implementation
uses Math;
{$R *.dfm}
const
MAX_START_SPEED = 10000;
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;
Ball.Iterate;
AnimateTimer.Enabled := True;
end;
procedure TMainForm.PauseButtonClick(Sender: TObject);
begin
AnimateTimer.Enabled := False;
end;
procedure TMainForm.FormPaint(Sender: TObject);
begin
if FDrawInited then
Ball.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);
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
SpeedEdit.Text := FloatToStr(MAX_START_SPEED);
SpeedUpDown.Position := Round(StrToFloat(SpeedEdit.Text) * 10);
except
SpeedEdit.Text := FloatToStr(SpeedUpDown.Position / 10);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
SpeedUpDown.Max := High(SmallInt);
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 FDrawInited then
begin
InitDrawing(WorkAreaPanel);
FDrawInited := True;
end;
PauseAction.Enabled := True;
PauseAction.Caption := PAUSE_CAPTION;
AnimateTimer.Enabled := False;
BallDefaultZeroSpeed := SpeedUpDown.Position / 10;
BallVariable.Radius := RadiusUpDown.Position * 10;
if not AutoGenerateCheckBox.Checked then
with 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
MovementParams.Alpha := Pi / StrToFloat(AngleEdit.Text);
Ball.Restart(WorkAreaPanel.ClientWidth, WorkAreaPanel.ClientHeight,
AutoGenerateCheckBox.Checked, RandomAngleCheckBox.Checked);
if AutoGenerateCheckBox.Checked then
with 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 / MovementParams.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 FDrawInited then
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, VectoryAlgebra;
type
// Мяч.
TBall = record
// Координата X центра.
X: Double;
// Координата Y центра.
Y: Double;
// Радиус.
Radius: Double;
// Скорость.
Speed: Double;
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);
// Параметры движения мяча.
TBallMovementParams = record
// Текущий момент времени для расчета параболы.
TimeMoment: Double;
// Угол альфа для расчета параболы.
Alpha: Double;
// Предыдущее значение координат мяча.
PreviousPoint: TVector2R;
// 0-точка движения по параболе.
ZeroPoint: TVector2R;
// Скорость в 0 точке.
ZeroPointSpeed: Double;
end;
// Отрисовать.
procedure Draw;
// Изменить размер коробки.
procedure ResizeBox(
// Ширина коробки.
const ABoxWidth: Integer;
// Высота коробки.
const ABoxHeight: Integer);
// Начать заново.
procedure Restart(
// Ширина коробки.
const ABoxWidth: Integer;
// Высота коробки.
const ABoxHeight: Integer;
// Автоматически генерировать поверхность.
const AIsAutoGeneratedSurface: Boolean;
// Случайный угол падения мяча.
const AIsRandomAngle: Boolean);
// Конструктор.
procedure InitDrawing(
// Окно на котором идет отрисовка.
const AWindow: TWinControl);
// Выполнить итерацию.
procedure Iterate;
var
// Скорость в 0 точке при рестарте.
BallDefaultZeroSpeed: Double;
// Коэффициент передачи энергии при ударе.
EnegryTransmissionMultiplier: Double;
// Мяч.
BallVariable: TBall;
// Параметры генерации поверхности.
SurfaceGenerationParams: TSurfaceGenerationParams;
// Параметры движения мяча.
MovementParams: TBallMovementParams;
implementation
uses
Math, Types, SysUtils, Classes;
var
// Высота коробки
BoxHeight: Integer;
// Ширина коробки.
BoxWidth: Integer;
// Поверхность.
Surface: TSurface;
// Окно на котором идет отрисовка.
DrawingWindow: TWinControl;
// Задний план.
Background: TBitmap;
function GetBallRect: TRect;
begin
Result.TopLeft.X := Round(BallVariable.X - BallVariable.Radius);
Result.TopLeft.Y := Round(BallVariable.Y + BallVariable.Radius);
Result.BottomRight.X := Round(BallVariable.X + BallVariable.Radius);
Result.BottomRight.Y := Round(BallVariable.Y - BallVariable.Radius);
end;
procedure CalculateAlpha(
const AContactType: TContactType; const ASurfacePointIndex: Integer);
var
ContactPoint, PreviousPointMove, Perpendicular: TVector2R;
BufferAlpha, Teta, AxisDifferenceAngle: Double;
begin
// Определить точку контакта.
case AContactType of
ctBoxLeft:
ContactPoint := AddVect2R(Vector2R(BallVariable.X, BallVariable.Y), Vector2R(- BallVariable.Radius, 0));
ctBoxRight:
ContactPoint := AddVect2R(Vector2R(BallVariable.X, BallVariable.Y), Vector2R(BallVariable.Radius, 0));
ctBoxTop:
ContactPoint := AddVect2R(Vector2R(BallVariable.X, BallVariable.Y), Vector2R(0, BallVariable.Radius));
ctBoxBottom:
ContactPoint := AddVect2R(Vector2R(BallVariable.X, BallVariable.Y), Vector2R(0, - BallVariable.Radius));
ctSurface:
ContactPoint := Vector2R(Surface[ASurfacePointIndex].X, Surface[ASurfacePointIndex].Y);
end;
with MovementParams do
begin
PreviousPointMove := SubVect2R(PreviousPoint,
Vector2R(BallVariable.X, BallVariable.Y));
Perpendicular := RightPerpendicularVector2R(SubVect2R(Vector2R(BallVariable.X, BallVariable.Y), ContactPoint));
BufferAlpha := AngelFromVectorToVector(Perpendicular, PreviousPointMove);
Teta := Pi - BufferAlpha;
AxisDifferenceAngle := AngelFromVectorToVector2Pi(Vector2R(1, 0), Perpendicular);
Alpha := Teta + AxisDifferenceAngle;
TimeMoment := 0;
ZeroPoint.X := BallVariable.X;
ZeroPoint.Y := BallVariable.Y;
ZeroPointSpeed := BallVariable.Speed;
end;
end;
procedure CheckContact;
var
I, MinSurfaceDistanceIndex: Integer;
MinSurfaceDistance, Distance: Double;
begin
with MovementParams do
begin
// Проверить касание коробки.
if (GetBallRect.Left <= 0) and (BallVariable.X <= PreviousPoint.X) then
CalculateAlpha(ctBoxLeft, 0) else
if (GetBallRect.Right >= BoxWidth) and (BallVariable.X >= PreviousPoint.X) then
CalculateAlpha(ctBoxRight, 0)else
if (GetBallRect.Top >= BoxHeight) and (BallVariable.Y >= PreviousPoint.Y) then
CalculateAlpha(ctBoxTop, 0)else
if (GetBallRect.Bottom <= 0) and (BallVariable.Y <= PreviousPoint.Y) then
CalculateAlpha(ctBoxBottom, 0)else
begin
// Проверить касание поверхности.
MinSurfaceDistance := 1.7e308;
MinSurfaceDistanceIndex := -1;
for I := 0 to Length(Surface) - 1 do
begin
Distance := DistBetweenPoints2R(Vector2R(Surface[I].X, Surface[I].Y),
Vector2R(BallVariable.X, BallVariable.Y));
if Distance < MinSurfaceDistance then
begin
MinSurfaceDistance := Distance;
MinSurfaceDistanceIndex := I;
end;
end;
if (MinSurfaceDistanceIndex <> -1) and (MinSurfaceDistance <= BallVariable.Radius) and
(MinSurfaceDistance < DistBetweenPoints2R(Vector2R(Surface[MinSurfaceDistanceIndex].X,
Surface[MinSurfaceDistanceIndex].Y), PreviousPoint)) then
CalculateAlpha(ctSurface, MinSurfaceDistanceIndex);
end;
end;
end;
procedure CalculateSurfaceMinY;
var
I, CalculatedValue: Integer;
begin
with SurfaceGenerationParams 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 GenerateRandomSurfaceParams;
begin
with SurfaceGenerationParams 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 GenerateSurface;
var
I: Integer;
begin
SetLength(Surface, 0);
SetLength(Surface, BoxWidth);
with SurfaceGenerationParams do
begin
for I := 0 to BoxWidth - 1 do
begin
Surface[I].X := I;
// Сложить 2 синуосоиды.
Surface[I].Y := Round(
(FirstSinusoidMultiplier * Sin(I / FirstSinusoidDivider) - pi / FirstSinusoidPIShift) +
SinOperation * (SecondSinusoidMultiplier * Sin(I/ SecondSinusoidDivider) +
pi / SecondSinusoidPIShift));;
end;
// Необходимо поднять поверхность, чтобы она отображалась целиком.
for I := 0 to BoxWidth - 1 do
Surface[I].Y := Surface[I].Y + Abs(SurfaceMinY);
end;
end;
procedure Iterate;
var
I: Integer;
IterateCount: Integer;
begin
if BallVariable.Speed > 1 then
IterateCount := Round(BallVariable.Speed) + 10
else
IterateCount := 1;
with MovementParams do
for I := 1 to IterateCount do
begin
TimeMoment := TimeMoment + 0.01 / IterateCount;
PreviousPoint := Vector2R(BallVariable.X, BallVariable.Y);
BallVariable.X := ZeroPoint.X + Cos(Alpha) * ZeroPointSpeed * TimeMoment * 100;
BallVariable.Y := ZeroPoint.Y + (Sin(Alpha) * ZeroPointSpeed * TimeMoment -
4.9 * Sqr(TimeMoment)) * 100;
BallVariable.Speed := Sqrt(Sqr(ZeroPointSpeed * Cos(Alpha)) +
Sqr(ZeroPointSpeed * Sin(Alpha) - 9.8 * TimeMoment));
CheckContact;
end;
Draw;
end;
function InvertRect(ARect: TRect): TRect;
begin
Result := ARect;
Result.TopLeft.Y := BoxHeight - Result.TopLeft.Y;
Result.BottomRight.Y := BoxHeight - Result.BottomRight.Y;
end;
function Invert(APoint: TPoint): TPoint;
begin
Result.X := APoint.X;
Result.Y := BoxHeight - APoint.Y;
end;
procedure GenerateBackground;
var
DrawableSurface: array of TPoint;
I: Integer;
begin
if not Assigned(Background) then
Background := TBitmap.Create;
Background.Width := BoxWidth;
Background.Height := BoxHeight;
SetLength(DrawableSurface, Length(Surface) + 2);
try
for I := 0 to Length(Surface) - 1 do
DrawableSurface[I] := Invert(Surface[I]);
DrawableSurface[Length(Surface)].X := BoxWidth;
DrawableSurface[Length(Surface)].Y := BoxHeight;
DrawableSurface[Length(Surface) + 1].X := 0;
DrawableSurface[Length(Surface) + 1].Y := BoxHeight;
with Background.Canvas do
begin
Pen.Color := clRed;
Brush.Color := clWhite;
Rectangle(DrawingWindow.ClientRect);
Brush.Color := clRed;
Polygon(DrawableSurface);
end;
finally
SetLength(DrawableSurface, 0);
end;
end;
procedure ResizeBox(const ABoxWidth,
ABoxHeight: Integer);
begin
BoxWidth := ABoxWidth;
BoxHeight := ABoxHeight;
GenerateSurface;
GenerateBackground;
end;
procedure Restart(const ABoxWidth,
ABoxHeight: Integer; const AIsAutoGeneratedSurface,
AIsRandomAngle: Boolean);
var
RandomAnglePart: Integer;
begin
BoxWidth := ABoxWidth;
BoxHeight := ABoxHeight;
if AIsAutoGeneratedSurface then
GenerateRandomSurfaceParams;
CalculateSurfaceMinY;
GenerateSurface;
BallVariable.X := BoxWidth / 2;
BallVariable.Y := BoxHeight * 3 / 4;
BallVariable.Speed := 0;
with MovementParams do
begin
PreviousPoint := Vector2R(BallVariable.X, BallVariable.Y);
ZeroPoint := Vector2R(BallVariable.X, BallVariable.Y);
ZeroPointSpeed := BallDefaultZeroSpeed;
TimeMoment := 0;
if AIsRandomAngle then
begin
Randomize;
RandomAnglePart := Random(11) - 5;
if InRange (RandomAnglePart, -1, 1) then
RandomAnglePart := - 3;
Alpha := pi / RandomAnglePart;
end;
end;
GenerateBackground;
Draw;
end;
procedure InitDrawing(
const AWindow: TWinControl);
begin
DrawingWindow := AWindow;
end;
procedure Draw;
var
BufferBitmap: TBitmap;
DC: HDC;
begin
BufferBitmap := TBitmap.Create;
try
BufferBitmap.Width := BoxWidth;
BufferBitmap.Height := BoxHeight;
if Assigned(Background) then
BitBlt(BufferBitmap.Canvas.Handle, 0, 0, BoxWidth, BoxHeight,
Background.Canvas.Handle, 0, 0, SRCCOPY);
with BufferBitmap.Canvas do
begin
Pen.Color := clBlue;
Brush.Color := clBlue;
Ellipse(Ball.InvertRect(GetBallRect));
end;
DC := GetWindowDC(DrawingWindow.Handle);
try
BitBlt(DC, 0, 0, BoxWidth, BoxHeight,
BufferBitmap.Canvas.Handle, 0, 0, SRCCOPY);
finally
ReleaseDC(DrawingWindow.Handle, DC);
end;
finally
BufferBitmap.Free;
end;
end;
procedure FreeObjects;
begin
SetLength(Surface, 0);
FreeAndNil(Background);
end;
initialization
BallVariable.Radius := 20.0;
BallDefaultZeroSpeed := 0;
EnegryTransmissionMultiplier := 1;
finalization
FreeObjects;
end.