Пользовательский интерфейс

Для программы был разработан интерфейс со свободной навигацией. На рисунке 3.4 приведен вид главной формы приложения.

Рисунок 3.4 – Главное окно приложения

В нижней части окна располагается панель управления, которую можно скрыть. Нажатие на кнопку рестарт приводит к прерыванию текущего движению и началу нового случайного. Нажатие на кнопку пауза приостанавливает движение.

На панели управления находится группа визуальных элементов, позволяющих задать параметры мяча – начальную скорость, радиус, а также начальный угол падения.

Также можно задать параметры генерации поверхности. Результирующая поверхность является результатом сложения или разности двух синусоид, параметры которых также можно задать. Это позволяет создать достаточно сложную поверхность (см. рисунок 3.5).

Рисунок 3.5 – Произвольная поверхность

Скрыть и восстановить панель управления можно из главного меню приложения.

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

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;

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;

OperationEdit.Text := OPERATION_PLUS;

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;

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;

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;

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;

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;

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

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

Surface[MinSurfaceDistanceIndex].Y), PreviousPoint)) then

CalculateAlpha(ctSurface, MinSurfaceDistanceIndex);

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;

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;

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;

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;

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;

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;

procedure FreeObjects;

begin

SetLength(Surface, 0);

FreeAndNil(Background);

end;

initialization

BallVariable.Radius := 20.0;

BallDefaultZeroSpeed := 0;

EnegryTransmissionMultiplier := 1;

finalization

FreeObjects;

end.

Вывод

Поставленная цель выполнена – с использованием структурного подхода было разработано и реализовано приложение, решающее поставленную задачу.

Лабораторная работа № 2 «Технология тестирования ПО при структурном подходе»

Постановка задачи

Разработать и провести тесты для приложения, реализованного в лабораторной работе № 1, по методу «белого ящика».

Цель работы

Изучить метод «белого ящика» тестирования ПО и применить полученные знания на практике.

Проектирование тестов

Далее приведено проектирование тестов по методу «белого ящика» для узкого места приложения – метода определения касания. Формирование тестовых наборов осуществляется по принципу покрытия условий.

Код метода проверки касания.

function CheckContact: Integer;

var

Index: Integer;

MinSurfaceDistance: Double;

begin

Result := 0;

with MovementParams do

begin

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

if (GetBallRect.Left <= 0) and (BallVariable.X <= PreviousPoint.X) then

begin

Result := 1;

CalculateAlpha(ctBoxLeft, 0);

end

else

if (GetBallRect.Right >= BoxWidth) and (BallVariable.X >= PreviousPoint.X) then

begin

Result := 2;

CalculateAlpha(ctBoxRight, 0);

end

else

if (GetBallRect.Top >= BoxHeight) and (BallVariable.Y >= PreviousPoint.Y) then

begin

Result := 3;

CalculateAlpha(ctBoxTop, 0);

end

else

if (GetBallRect.Bottom <= 0) and (BallVariable.Y <= PreviousPoint.Y) then

begin

Result := 4;

CalculateAlpha(ctBoxBottom, 0)

end

else

begin

CalculateMinSurfaceDistance(Index, MinSurfaceDistance);

if (Index <> -1) and (MinSurfaceDistance <= BallVariable.Radius) and

(MinSurfaceDistance < DistBetweenPoints2R(Vector2R(Surface[Index].X,

Surface[Index].Y), PreviousPoint)) then

begin

Result := 5;

CalculateAlpha(ctSurface, Index);

end;

Входными данными являются параметры передвижения MovementParams, параметры мяча BallVariable, и поверхность Surface.

Представление метода в виде графа изображено на рисунке 3.1.

Рисунок 3.1 – Метод CheckContact, представленный в виде графа

Как видно из рисунка в методе имеется 5 условий, выполнение каждого из которых делает невозможным выполнение остальных. Таким образом, необходимо сформировать данные для следующих переходов 1-2-3-12, 1-2-4-5-12, 1-2-4-6-7-12, 1-2-4-6-8-9-12, 1-2-4-6-8-10-11-12 и 1-2-4-6-8-10-12. В таблице 3.1 приведены данные удовлетворяющие переходам.

Таблица 3.1.

Переход	Значения параметров	Ожидаемый результат
1-2-3-12	BallVariable.Radius = 20; BallVariable.X = 20; PreviousPointX = 20
1-2-4-5-12	BoxWidth = 600; BallVariable.Radius = 20; BallVariable.X = 581; PreviousPointX = 580
1-2-4-6-7-12	BoxHeight = 480; BoxWidth = 600; BallVariable.Radius = 20; BallVariable.Y = 461; BallVariable.X = 300; PreviousPointY = 460; PreviousPointX = 300
1-2-4-6-8-9-12	BoxHeight = 480; BoxWidth = 600; BallVariable.Radius = 20; BallVariable.Y = 20; BallVariable.X = 300; PreviousPointY = 21; PreviousPointX = 300
1-2-4-6-8-10-11-12	BoxHeight = 480; BoxWidth = 600; BallVariable.Radius = 20; BallVariable.Y = 40; BallVariable.X = 300; PreviousPointY = 41; PreviousPointX = 300;Surface[0] .X =300; Surface[0] .Y =20;
1-2-4-6-8-10-12	BoxHeight = 480; BoxWidth = 600; BallVariable.Radius = 20; BallVariable.Y = 40; BallVariable.X = 300; PreviousPointY = 20; PreviousPointX = 300;Surface[0] .X =300; Surface[0] .Y =20; Length(Surface) = 1;

Результаты тестирования

Для проведения тестирования реализуем метод, задающий тестовые параметры, вызывающий метод CheckContact, анализирующий код возврата работы функции, и протоколирующий результаты выполнения тестов. Ниже приведен исходный код из модуля тестирования, относящийся к проверке метода CheckContact.

type

TTestSet = record

InputParams: TBallMovementParams;

InputBall: TBall;

SurfacePoint: TPoint;

ExpectedResult: Integer;

end;

const

TestData: array[0..5] of TTestSet = (

(InputParams : (PreviousPoint:(X: 20));

InputBall:(X: 20; Radius: 20); ExpectedResult: 1),

(InputParams : (PreviousPoint:(X: 580));

InputBall:(X: 581; Radius: 20); ExpectedResult: 2),

(InputParams : (PreviousPoint:(X: 300; Y:460));

InputBall:(X: 300; Y: 461; Radius: 20); ExpectedResult: 3),

(InputParams : (PreviousPoint:(X: 300; Y:21));

InputBall:(X: 300; Y: 20; Radius: 20); ExpectedResult: 4),

(InputParams : (PreviousPoint:(X: 300; Y:41));

InputBall:(X: 300; Y: 40; Radius: 20); SurfacePoint: (X: 300; Y: 20);

ExpectedResult: 5),

(InputParams : (PreviousPoint:(X: 300; Y:20));

InputBall:(X: 300; Y: 40; Radius: 20); SurfacePoint: (X: 300; Y: 20);

ExpectedResult: 0));

procedure CheckContactTest;

const

WINDOW_WIDTH = 600;

WINDOW_HEIGHT = 480;

LOG_NAME = 'CheckContactLog.txt';

RESULT_FORMAT = 'Result = %d and Expected result = %d => Test %s' + sLineBreak;

SUCCEED_RESULT = 'Succeed';

FAILED_RESULT = 'Failed';

var

I: Integer;

LogStream: TStringStream;

SaveStream: TFileStream;

CallResult: Integer;

begin

LogStream := TStringStream.Create('');

try

Restart(WINDOW_WIDTH, WINDOW_HEIGHT, True, True);

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

begin

MovementParams.PreviousPoint := TestData[I].InputParams.PreviousPoint;

BallVariable.X := TestData[I].InputBall.X;

BallVariable.Y := TestData[I].InputBall.Y;

SetLength(Surface, 0);

SetLength(Surface, 1);

Surface[0] := TestData[I].SurfacePoint;

CallResult := CheckContact;

if CallResult = TestData[I].ExpectedResult then

LogStream.WriteString(Format(RESULT_FORMAT,

[CallResult, TestData[I].ExpectedResult, SUCCEED_RESULT]))

else

LogStream.WriteString(Format(RESULT_FORMAT,

[CallResult, TestData[I].ExpectedResult, FAILED_RESULT]));

end;

finally

SaveStream := TFileStream.Create(LOG_NAME, fmCreate);

try

LogStream.Position := 0;

SaveStream.CopyFrom(LogStream, LogStream.Size);

finally

SaveStream.Free;

end;

LogStream.Free;

end;

В результате работы тестового метода в файле протокола находятся следующие результаты.

Result = 1 and Expected result = 1 => Test Succeed

Result = 2 and Expected result = 2 => Test Succeed

Result = 3 and Expected result = 3 => Test Succeed

Result = 4 and Expected result = 4 => Test Succeed

Result = 5 and Expected result = 5 => Test Succeed

Result = 0 and Expected result = 0 => Test Succeed

Полученные результаты говорят о верности работы метода CheckContact.

Вывод

Поставленная цель выполнена – был изучена методология тестирования программного обеспечения по принципу «белого ящика», полученные знания были применены на практике для проектирования и реализации автотеста, проверяющего корректность работы метода CheckContact.

Лабораторная работа № 3 «Технология разработки ПО при объектном подходе»

Постановка задачи

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

Цель работы

Изучить технологию разработки ПО при объектно-ориентированном подходе. Применить полученные знания на практике, разработав программу.

⇐ Назад