Список літератури

1. Пример кода : Класс скелета многоугольника с основанными классами треугольника и квадрата - http://www.delphibasics.ru/Abstract.php

2. Стек. Отличия стека от списка. Основные операции со стеком - http://informatics.mccme.ru/mod/book/view.php?id=543

3. Диалоговые окна для вывода сообщений в Delphi (ShowMessage, MessageDlg и MessageDlgPos) - http://delphi-prg.ru/prostye-dialogovye-okna-v- delphi-showmessage-messagedlg-i-messagedlgpos

4. Литвиненко С. M.. Методичні вказівки до виконання курсової роботи

з дисципліни «Об'єктно-орієнтоване програмування» для студентів напряму підготовки 6.050101 „Комп'ютерні науки" - X.: ХНУБА, 2014. - 26с.

5. Как очистить все поля компонентов -

http://hashcode.rU/questions/l 1473 l/delphi-%D0%BA%D0%B0%D0%BA- %D0%BE%D 1 %87%D0%B 8%D 1 %81 %D 1 %82%D0%B8%D 1 %82%D 1 %8C- %D0%B2%D 1 %81 %D0%B 5 -%D0%BF%D0%BE%D0%BB%D 1 %8F- %D0%BA%D0%BE%D0%BC%D0%BF%D0%BE%D0%BD%D0%B5%D0%B D%D 1 %82%D0%BE%D0%B2

6. Форма-заставка в Delphi ХЕ - http://delphicomponent.ru/521-forma-zastavka- v-delphi-xe.html

7. Буч Г. Объектно-ориентированный анализ и проектирование с примерами приложений. - М.: ООО «И. Д. Вильяме», 2008. - 720 с.

8. Эдвард Йордон, Карл Аргила. Структурные модели в объектно- ориентированном анализе и проектировании. - Лори, 1999. - 268 с.

ДОДАТОК А

Вихідній код (лістинг)створення програми

Код модуля PolyUnit.pas

unit PolyUnit;

interface

uses SysUtils, ExtCtrls, Graphics, Types, Grids, Math, dialogs;

type

TPoint = class

private

tx, ty: integer;

function GetX: integer;

function GetY: integer;

public

constructor Create(NewX, NewY: integer);

property X: integer read GetX;

property Y: integer read GetY;

end;

TParal = class

A, B, C, D: TPoint;

constructor Create(X1, Y1, X2, Y2, X3, Y3, X4, Y4: integer);

destructor Destroy; override;

function Perimeter: double; virtual;

function Area: double; virtual;

end;

TFigure = class(TParal)

private

ph : word;

public

next: TFigure;

constructor Create(X1, Y1, X2, Y2, X3, Y3, X4, Y4: integer; h: word);

function GetH: word;

procedure SetH(NewH: word);

function Volume: Double; virtual; abstract;

procedure Drawing(pict: TCanvas; width, height: word); virtual; abstract;

end;

TPrism = class(TFigure)

function Area: double; override;

function Volume: double; override;

procedure Drawing(pict: TCanvas; width, height: word); override;

end;

TPyramid = class(TFigure)

function Area: double; override;

function Volume: double; override;

procedure Drawing(pict: TCanvas; width, height: word); override;

end;

TLIFO = class

left: TFigure;

Constructor Create;

Destructor Destroy; override;

Procedure AddLeft(f: TFigure);

Procedure DeleteLeft;

Procedure ShowInfo(info: TStringGrid);

Function TotalArea: double;

Procedure DrawingLeft(pict: TCanvas; width, height : word);

procedure EditHeight(NewH: word);

end;

implementation

//точка

function TPoint.GetX: integer;

begin

result:= tx;

end;

function TPoint.GetY: integer;

begin

result:= ty;

end;

constructor TPoint.Create(NewX, NewY: Integer);

begin

inherited Create;

tx:= NewX;

ty:= NewY;

end;

//параллелограмм

constructor TParal.Create(X1, Y1, X2, Y2, X3, Y3, X4, Y4: integer);

begin

inherited Create;

if ( sqrt(sqr(x1 - x2) + sqr(y1 - y2)) = sqrt(sqr(x3 - x4) + sqr(y3 - y4)) )

and ( sqrt(sqr(x1 - x4) + sqr(y1 - y4)) = sqrt(sqr(x2 - x3) + sqr(y2 - y3))) then

begin

A:= TPoint.Create(X1, Y1);

B:= TPoint.Create(X2, Y2);

C:= TPoint.Create(X3, Y3);

D:= TPoint.Create(X4, Y4);

end

else

raise Exception.Create('Ошибка ввода координат!');

end;

function TParal.Perimeter: double;

begin

result:= 2*sqrt(sqr(d.x - a.x) + sqr(d.y - a.y)) + 2*sqrt(sqr(a.x - b.x) + sqr(a.y - b.y));

end;

function TParal.Area : Double;

begin

result:= sqrt(sqr(a.x - b.x) + sqr(a.y - b.y)) * sqrt(sqr(a.x - c.x) + sqr(a.y - c.y));

end;

destructor TParal.Destroy;

begin

A.free;

B.free;

C.free;

D.free;

inherited destroy;

end;

//фигура

constructor TFigure.Create(X1, Y1, X2, Y2, X3, Y3, X4, Y4: integer; h : word);

begin

inherited Create(X1, Y1, X2, Y2, X3, Y3, X4, Y4);

if h = 0 then

raise Exception.Create('Высота не должна быть равна нулю!')

else

begin

ph := h;

next:= nil;

end;

end;

function TFigure.GetH : word;

begin

result:= ph;

end;

procedure TFigure.SetH(NewH: Word);

begin

if NewH = 0 then

raise Exception.Create('Высота не должна быть равна нулю!')

else

ph := NewH;

end;

//призма

function TPrism.Area: double;

begin

result:= sqrt(sqr(a.x - b.x) + sqr(a.y - b.y))*

(2*(sqrt(sqrt(sqr(a.x - d.x) + sqr(a.y - d.y))/2)+sqr(ph))+sqrt(sqr(a.x - d.x) + sqr(a.y - d.y)))+

ph*sqrt(sqr(a.x - d.x) + sqr(a.y - d.y))

end;

function TPrism.Volume: Double;

begin

result:= ((sqrt(sqr(a.x - d.x) + sqr(a.y - d.y))*ph)/2) * sqrt(sqr(a.x - b.x) + sqr(a.y - b.y));

end;

procedure TPrism.Drawing(pict : TCanvas; width, Height : word);

var x1,x2,x3,x4,y1,y2,y3,y4 : integer;

begin

x1 := a.x + a.y div 2 + width div 3;

x2 := b.x + b.y div 2 + width div 3;

x3 := c.x + c.y div 2 + width div 3;

x4 := d.x + d.y div 2 + width div 3;

y1 := -a.y div 2 + 2*Height div 3;

y2 := -b.y div 2 + 2*Height div 3;

y3 := -c.y div 2 + 2*Height div 3;

y4 := -d.y div 2 + 2*Height div 3;

pict.Pen.Color := clRed;

pict.Polyline([ Point(x1,y1), Point(x2,y2), Point(x3,y3), Point(x4,y4),Point(x1,y1)]);

pict.Polyline([ Point(x1,y1), Point((x1 + x2) div 2,(y1 + y2 )div 2 - ph ), Point(x2,y2) ]);

pict.Polyline([ Point(x3,y3), Point((x3 + x4) div 2, (y3 + y4 )div 2 - ph), Point(x4,y4) ]);

pict.Polyline([ Point((x1 + x2) div 2,(y1 + y2 )div 2 - ph ), Point((x3 + x4) div 2, (y3 + y4 )div 2 - ph )]);

end;

//пирамида

function TPyramid.Area: double;

begin

result:= ((inherited perimeter*ph)/2) + inherited area;

end;

function TPyramid.Volume: double;

begin

result:= ( inherited Area * ph) /3;

end;

procedure TPyramid.Drawing(pict: TCanvas; width, Height : word);

var x1,x2,x3,x4,y1,y2,y3,y4 : integer;

begin

x1 := a.x + a.y div 3 + width div 3;

x2 := b.x + b.y div 3 + width div 3;

x3 := c.x + c.y div 3 + width div 3;

x4 := d.x + d.y div 3 + width div 3;

y1 := -a.y div 3 + 2*Height div 3;

y2 := -b.y div 3 + 2*Height div 3;

y3 := -c.y div 3 + 2*Height div 3;

y4 := -d.y div 3 + 2*Height div 3;

pict.Pen.Color := clRed;

pict.Polyline([Point(x1,y1), Point(x2,y2), Point(x3,y3), Point(x4,y4),Point(x1,y1)]);

pict.MoveTo(x1,y1);

pict.LineTo( (((x1 + x2) div 2) + ((x3 + x4) div 2)) div 2, (((y1 + y2) div 2) + ((y3 + y4) div 2)) div 2 - ph );

pict.MoveTo(x2,y2);

pict.LineTo( (((x1 + x2) div 2) + ((x3 + x4) div 2)) div 2, (((y1 + y2) div 2) + ((y3 + y4) div 2)) div 2 - ph );

pict.MoveTo(x3,y3);

pict.LineTo( (((x1 + x2) div 2) + ((x3 + x4) div 2)) div 2, (((y1 + y2) div 2) + ((y3 + y4) div 2)) div 2 - ph );

pict.MoveTo(x4,y4);

pict.LineTo( (((x1 + x2) div 2) + ((x3 + x4) div 2)) div 2, (((y1 + y2) div 2) + ((y3 + y4) div 2)) div 2 - ph );

end;

//стек

constructor TLIFO.Create;

Begin

inherited Create;

left:=nil;

End;

destructor TLIFO.Destroy;

Begin

While left <> Nil do DeleteLeft;

inherited Destroy;

End;

procedure TLIFO.AddLeft(f: TFigure);

Begin

if left = nil then

left:= f

else

begin

f.next:=left;

left:= f;

end;

End;

procedure TLIFO.DeleteLeft;

var d: TFigure;

Begin

if left <> nil then

begin

d:= left;

left:=d.next;

d.free;

end;

End;

function TLIFO.TotalArea: double;

var d: TFigure; amount: Double;

Begin

d:=left;

amount:=0;

While d <> Nil do

Begin

amount:=amount+d.Area;

d:=d.next;

End;

result:=amount;

End;

Procedure TLIFO.ShowInfo(info: TStringGrid);

var u: TFigure;

i: byte;

begin

info.ColCount := 10;

for i := 0 to info.ColCount - 1 do

info.Cols[i].Clear;

info.Cells[0,0] := '№';

info.Cells[1,0] := 'Тип';

info.Cells[2,0] := 'Точка А';

info.Cells[3,0] := 'Точка B';

info.Cells[4,0] := 'Точка С';

info.Cells[5,0] := 'Точка D';

info.Cells[6,0] := 'Высота h';

info.Cells[7,0] := 'Периметр P';

info.Cells[8,0] := 'Площадь S';

info.Cells[9,0] := 'Объем V';

if left <> nil then

begin

u := left;

i := 1;

while u <> nil do

begin

i := i+1;

info.RowCount := i;

info.Cells[0,i-1] := IntToStr(i-1);

if u is TPrism then

info.Cells[1,i-1] := 'Призма'

else

info.Cells[1,i-1] := 'Пирамида';

info.Cells[2,i-1] := '(' + FloatToStr(u.a.x) + ', ' + FloatToStr(u.a.y) + ')';

info.Cells[3,i-1] := '(' + FloatToStr(u.b.x) + ', ' + FloatToStr(u.b.y) + ')';

info.Cells[4,i-1] := '(' + FloatToStr(u.c.x) + ', ' + FloatToStr(u.c.y) + ')';

info.Cells[5,i-1] := '(' + FloatToStr(u.d.x) + ', ' + FloatToStr(u.d.y) + ')';

info.Cells[6,i-1] := FloatToStr(u.getH);

info.Cells[7,i-1] := FloatToStr(RoundTo(u.Perimeter, -4));

info.Cells[8,i-1] := FloatToStr(RoundTo(u.Area, -4));

info.Cells[9,i-1] := FloatToStr(RoundTo(u.Volume, -4));

u := u.next;

end;

end;

end;

Procedure TLIFO.DrawingLeft(pict: TCanvas; width, height : word);

begin

if left <> nil then

left.Drawing(pict, width, height);

end;

procedure TLIFO.EditHeight(NewH: word);

begin

if left <> nil then

left.SetH(NewH);

end;

end.

Код модуля GeoForm.pas

unit GeoForm;

interface

uses

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

Dialogs, Menus, PresUnit, Grids, Calculate, PolyUnit, reference;

type

TFigureForm = class(TForm)

MainMenu1: TMainMenu;

GridList: TStringGrid;

N1: TMenuItem;

N2: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

procedure N6Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N10Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCreate(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N12Click(Sender: TObject);

procedure N13Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FigureForm: TFigureForm;

FigureStack : TLIFO = nil;

f : TFigure = nil;

implementation

uses PictUnit, AddH;

{$R *.dfm}

procedure TFigureForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

FigureStack.Free;

end;

procedure TFigureForm.FormCreate(Sender: TObject);

begin

FigureStack := TLIFO.Create;

FigureStack.ShowInfo(GridList);

end;

procedure TFigureForm.N10Click(Sender: TObject);

begin

if MessageDlg('Удалить последнюю добавленную фигуру?', mtConfirmation,mbOkCancel,0 ) = mrOk then

begin

FigureStack.DeleteLeft;

FigureStack.ShowInfo(GridList);

end;

end;

procedure TFigureForm.N11Click(Sender: TObject);

begin

if MessageDlg('Очистить весь список?', mtConfirmation,mbOkCancel,0 ) = mrOk then

begin

FigureStack.Free;

FigureStack := TLIFO.Create;

FigureStack.ShowInfo(GridList);

end;

end;

procedure TFigureForm.N12Click(Sender: TObject);

begin

showmessage('Суммарная площадь фигур равна : ' + floattostr(FigureStack.TotalArea));

end;

procedure TFigureForm.N13Click(Sender: TObject);

begin

AddH.Hform.ShowModal;

FigureStack.ShowInfo(GridList);

end;

procedure TFigureForm.N3Click(Sender: TObject);

begin

reference.Form1.showmodal;

end;

procedure TFigureForm.N4Click(Sender: TObject);

begin

showmessage('GeoFigure - программа для расчета геометрических характеристик фигур в пространстве и на плоскости. Разработчик – Фещук Яна из группы КН-21 Харьковского Национального Университета Строительства и Архитектуры');

end;

procedure TFigureForm.N6Click(Sender: TObject);

begin

close;

end;

procedure TFigureForm.N7Click(Sender: TObject);

begin

with PictUnit.PictForm do

begin

Axis;

FigureStack.DrawingLeft(Pict.Canvas, Pict.Width, Pict.Height);

ShowModal;

end;

end;

procedure TFigureForm.N8Click(Sender: TObject);

begin

Calculate.CalculForm.FigureLabel.Caption := 'призмы';

Calculate.CalculForm.ShowModal;

end;

procedure TFigureForm.N9Click(Sender: TObject);

begin

Calculate.CalculForm.FigureLabel.Caption := 'пирамиды';

Calculate.CalculForm.ShowModal;

end;

end.

Код модуля PictUnit.pas

unit PictUnit;

interface

uses

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

Dialogs, ExtCtrls;

type

TPictForm = class(TForm)

pict: TImage;

procedure Axis;

private

{ Private declarations }

public

{ Public declarations }

end;

var

PictForm: TPictForm;

implementation

{$R *.dfm}

procedure TPictForm.Axis;

begin

with pict do begin

canvas.Pen.Color:=clWhite;

canvas.brush.Color:=clWhite;

canvas.Rectangle(0,0,Width,Height);

canvas.pen.Width:=2;

canvas.pen.color:=clBlue;

//стрелки

canvas.polyline([Point(width div 3 -10 ,120), Point(width div 3, 100 ),

Point(width div 3 + 10, 120)]);

canvas.polyline([Point(2*width div 3 -20 , height div 3 +5), point(2*width div 3, height div 3),

Point(2*width div 3 -5,height div 3 +20 )]);

canvas.polyline([Point(width -120 ,2*height div 3 - 10), Point(width - 100 ,2*width div 3 ),

Point(width -120 ,2*height div 3 + 10)]);

{Оси X, Z} canvas.polyline([Point(width div 3 ,100), Point(width div 3,2*height div 3 ),

Point(width - 100 ,2*width div 3)]);

{Ось Y} canvas.polyline([point(width div 3, 2*height div 3),point(2*width div 3, height div 3)]);

//надписи

canvas.Font.Size := 15;

canvas.TextOut(width - 120 ,2*height div 3 + 15,'X');

canvas.TextOut(2*width div 3 + 10 , height div 3, 'Y');

canvas.TextOut(width div 3 - 30, 100, 'Z');

canvas.TextOut(width div 3 - 15, 2*height div 3 ,'0');

end;

end;

end.

Код модуля PresUnit.pas

unit PresUnit;

interface

uses

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

Dialogs, jpeg, ExtCtrls, StdCtrls;

type

TPresent = class(TForm)

FigureImage: TImage;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormHide(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Present: TPresent;

implementation

{$R *.dfm}

procedure TPresent.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

CanClose:= Timer1.Enabled = False;

end;

procedure TPresent.FormHide(Sender: TObject);

begin

Repeat

Application.ProcessMessages

Until

Present.CloseQuery;

end;

procedure TPresent.Timer1Timer(Sender: TObject);

begin

Timer1.Enabled:= False;

end;

end.

Код модуля Calculate.pas

unit Calculate;

interface

uses

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

Dialogs, StdCtrls, PolyUnit;

type

TCalculForm = class(TForm)

Dx: TEdit;

Ax: TEdit;

Cx: TEdit;

Bx: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

AddButton: TButton;

Label5: TLabel;

FigureLabel: TLabel;

Dy: TEdit;

Ay: TEdit;

Cy: TEdit;

By: TEdit;

Label7: TLabel;

h: TEdit;

label9: TLabel;

Button1: TButton;

procedure AddFigure(Sender: TObject);

procedure InputValid(Sender: TObject; var press: Char);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

CalculForm: TCalculForm;

implementation

uses GeoForm;

{$R *.dfm}

procedure TCalculForm.AddFigure(Sender: TObject);

begin

try

if FigureLabel.caption = 'призмы' then

begin

GeoForm.F := TPrism.Create(StrToInt(Ax.Text),

StrToInt(Ay.Text),StrToInt(Bx.Text),StrToInt(By.Text),StrToInt(Cx.Text),

StrToInt(Cy.Text),StrToInt(Dx.Text),StrToInt(Dy.Text),StrToInt(h.Text));

GeoForm.FigureStack.addleft(f);

GeoForm.F := nil;

geoform.FigureStack.ShowInfo(FigureForm.GridList);

close;

end else

if FigureLabel.caption = 'пирамиды' then

begin

GeoForm.F := TPyramid.Create(StrToInt(Ax.Text),

StrToInt(Ay.Text),StrToInt(Bx.Text),StrToInt(By.Text),StrToInt(Cx.Text),

StrToInt(Cy.Text),StrToInt(Dx.Text),StrToInt(Dy.Text),StrToInt(h.Text));

GeoForm.FigureStack.AddLeft(F);

GeoForm.F := nil;

GeoForm.FigureStack.ShowInfo(FigureForm.GridList);

close;

end

except

ShowMessage('Ошибка ввода, пожалуйста, проверте значения');

end;

end;

procedure TCalculForm.Button1Click(Sender: TObject);

var i: byte;

begin

try

for i:= 1 to CalculForm.ComponentCount do

begin

if (CalculForm.Components[i] is TEdit) then

TEdit(CalculForm.Components[i]).Text:= '';

end;

except

end;

end;

procedure TCalculForm.InputValid(Sender: TObject; var press: Char);

begin

case press of

'0'..'9', '-', #8: ;

else press:=chr(0);

end;

end;

end.

Код модуля Refrence.pas

unit reference;

interface

uses

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

Dialogs, StdCtrls, jpeg, ExtCtrls;

type

TForm1 = class(TForm)

Image1: TImage;

Memo1: TMemo;

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

end.

Код файлу проекту GeoFigure.dpr

program GeoFigure;

uses

Forms,

GeoForm in 'GeoForm.pas' {FigureForm},

PolyUnit in 'PolyUnit.pas',

PresUnit in 'PresUnit.pas' {Present},

Calculate in 'Calculate.pas' {CalculForm},

PictUnit in 'PictUnit.pas' {PictForm},

reference in 'reference.pas' {Form1},

AddH in 'AddH.pas' {HForm};

{$R *.res}

begin

Application.Initialize;

Present := TPresent.Create(Application);

Present.Show;

Present.Update;

Application.Initialize;

Application.CreateForm(TFigureForm, FigureForm);

Application.CreateForm(THForm, HForm);

Present.Hide;

Present.Free;

Application.CreateForm(TCalculForm, CalculForm);

Application.CreateForm(TPictForm, PictForm);

Application.CreateForm(TForm1, Form1);

Application.Run;

end.