Блок-схема алгоритму процедури графічної побудови:

2.4 Програмний код додатку

Головна форма:

unit Unit1;

interface

uses

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

Dialogs, Menus, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

GroupBox2: TGroupBox;

PaintBox1: TPaintBox;

MainMenu1: TMainMenu;

N1: TMenuItem;

Button1: TButton;

GroupBox3: TGroupBox;

ColorBox1: TColorBox;

Label6: TLabel;

Label5: TLabel;

CheckBox1: TCheckBox;

Label7: TLabel;

Button2: TButton;

Label8: TLabel;

ColorBox2: TColorBox;

Label10: TLabel;

CheckBox3: TCheckBox;

Label11: TLabel;

ColorBox3: TColorBox;

Label13: TLabel;

ColorBox4: TColorBox;

N2: TMenuItem;

N3: TMenuItem;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Label3: TLabel;

N4: TMenuItem;

N5: TMenuItem;

Label4: TLabel;

Label9: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure ColorBox1Change(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure ColorBox2Change(Sender: TObject);

procedure CheckBox3Click(Sender: TObject);

procedure ColorBox3Change(Sender: TObject);

procedure ColorBox4Change(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure Activate(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

x0,y0:integer;

xe,ye:integer;

x,y:real;

dx,dy:real;

Mx,My:real;

xmin,xmax,ymin,ymax:integer;

a1,a2,b1,b2:integer;

xa,ya,xb,yb,xC,xD:real;

v,c:integer;

xn,yn:Real;

X1,Y1,Z1,yO:real;

w:integer;

vis:integer;

implementation

uses Unit3, Unit2, Unit4, Unit5, Unit6;

{$R *.dfm}

function ekrX(x:real):integer; //Преобразование X

begin

ekrX:=round(mx*(x-xmin)+a1);

end;

function ekrY(y:real):integer; //Преобразование Y

begin

ekrY:=round(my*(-y+ymax)+b1);

end;

procedure TForm1.Activate(Sender: TObject);

begin

if vis<>1

then

begin

Form2.ShowModal;

end;

End;

procedure TForm1.FormCreate(Sender: TObject);

begin

xmin:=-5; xmax:=5; ymin:=-5; ymax:=5;

a1:=0; a2:=410;

b1:=0; b2:=410;

dx:=1; dy:=1;

with PaintBox1.Canvas do

begin

Brush.Color:=clWhite;

Rectangle(-1,-1,PaintBox1.Width+1,PaintBox1.Height+1);

Pen.width:=1;

Pen.Color:=clBlack;

Mx:=round((a2-a1)/(xmax-xmin));

My:=round((b2-b1)/(ymax-ymin));

x0:=a1-round(mx)*xmin;

y0:=b1+round(my)*ymax;

Pen.width:=1;

Pen.Style:=psDot;

Pen.Color:=Colorbox2.Selected;;

Font.Color:=Colorbox3.Selected;

if checkbox3.checked=true then

begin

TextOut(a2-10,y0-15,'X');

TextOut(x0+5,b1+5,'Y');

TextOut(x0+5,y0-18,'0');

end;

x:=xmin;

repeat

Xe:=round(mx*(x-xmin)+a1);

if Checkbox1.Checked=true then

begin

MoveTo(xe,b1);LineTo(xe,b2);

end;

if checkbox3.checked=true then

begin

if x=(-5) then textOut(xe,y0+6,FloatToStr(x));

if (x<>0) and (x<>-5) then textOut(xe-8,y0+5,FloatToStr(x));

end;

x:=x+dx;

until(x>xmax);

y:=ymin;

repeat

Ye:=round(my*(-y+ymax)+b1);

if Checkbox1.Checked=true then

begin

MoveTo(a1,ye);LineTo(a2,ye);

end;

if checkbox3.checked=true then

begin

if y=5 then textOut(x0-20,ye,FloatToStr(y));

if (y<>0) and(y<>5) then textOut(x0-20,ye-12,FloatToStr(y));

end;

y:=y+dy;

until(y>ymax);

Font.Color:=clBlack;

Pen.Width:=2;

Pen.Color:=Colorbox1.Selected;;

Pen.Style:=psSolid;

MoveTo(a1,y0); LineTo(a2,y0);

MoveTo(x0,b1); LineTo(x0,b2);

//Расчет

If v=1 then

begin

X1:=yB-yA;

Y1:=xA-xB;

Z1:=xA*yB-xB*yA;

If Y1=0 then

begin

label5.Caption:='Заданная прямая пара-'+#13+'лельна оси ординат и'+#13

+'не имеет точки пересе-'+#13+'чения с ней';

ShowMessage('Заданная прямая паралельна оси ординат'+#13+

'и не имеет точки пересечения с ней');

Pen.Style:=psSolid;

Pen.Color:=ColorBox4.Selected;

MoveTo(ekrX(xa),ekrY(ya));LineTo(ekrX(xA),ekrY(10));

MoveTo(ekrX(xb),ekrY(yb));LineTo(ekrX(Xb),ekrY(-10));

end

else

begin

yO:=Z1/Y1;

label5.Caption:='Заданная прямая пересе-'+#13

+'кается с осью ординат в'+#13+'точке C ( 0 ; '

+FloatToStrF(yO,fffixed,4,2)+' )';

If X1=0 then

begin

Pen.Style:=psSolid;

Pen.Color:=ColorBox4.Selected;

MoveTo(ekrX(xa),ekrY(ya));LineTo(ekrX(10),ekrY(yA));

MoveTo(ekrX(xb),ekrY(yb));LineTo(ekrX(-10),ekrY(yB));

end

else

begin

xC:=(z1-y1*10)/x1;

xD:=(z1-y1*(-10))/x1;

Pen.Style:=psSolid;

Pen.Color:=ColorBox4.Selected;

MoveTo(ekrX(xa),ekrY(ya));LineTo(ekrX(xC),ekrY(10));

MoveTo(ekrX(xb),ekrY(yb));LineTo(ekrX(xD),ekrY(-10));

end;

//Вывод точки С

Pen.Color:=clRed;

Pen.Width:=1;

Pen.Style:=psSolid;

If (yO<ymin) or (yO>ymax) then

begin

label5.Caption:='Точка С лежит за пре-'+#13+'делами координатной'+#13

+'проскости';

end;

Ellipse(ekrX(0)-3,ekrY(yO)-3,ekrX(0)+3,ekrY(yO)+3);

textOut(ekrX(0)+6,ekrY(yO)+1,'C');

end;

Pen.Width:=2;

Pen.Style:=psSolid;

Pen.Color:=Colorbox4.Selected;

MoveTo(ekrX(xa),ekrY(ya));

LineTo(ekrX(xb),ekrY(yb));

Font.Color:=clRed;

textOut(ekrX(xA)+6,ekrY(yA)+1,'A');

textOut(ekrX(xB)+6,ekrY(yB)+1,'B');

Font.Color:=clBlack;

Pen.Color:=clBlack;

Pen.Width:=1;

Pen.Style:=psSolid;

Ellipse(ekrX(xA)-3,ekrY(yA)-3,ekrX(xA)+3,ekrY(yA)+3);

Ellipse(ekrX(xB)-3,ekrY(yB)-3,ekrX(xB)+3,ekrY(yB)+3);

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

v:=1;

xA:=StrToFloat(Edit1.Text);

yA:=StrToFloat(Edit2.Text);

xB:=StrToFloat(Edit3.Text);

yB:=StrToFloat(Edit4.Text);

//проверка не одинаковы ли точки

if xA=xB then

begin

If yA=yB then

begin

ShowMessage('Найдены были одинаковые координаты двух точек.'+#13+

'Пожалуйста откорректируйте введенные координаты.',);

v:=0;

label5.Caption:='';

end;

end;

//проверка не выходят ли точки за пределы координатной плоскости

If v<>0 then

begin

c:=0;

repeat

case c of

0:begin Xn:=xA; Yn:=yA; end;

1:begin Xn:=xb; Yn:=yB; end;

end;

If (Xn<xmin) or (Xn>xmax) or (Yn<Ymin) or (Yn>Ymax) then

begin

v:=0;

ShowMessage('Одна из введенных точек выходит'+#13

+'за пределы координатной плоскости');

label5.Caption:='';

end;

c:=c+1;

until(c>1);

end;

paintbox1.Repaint;

end;

procedure TForm1.ColorBox1Change(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

v:=0;

label5.Caption:='';

Paintbox1.Repaint;

end;

procedure TForm1.ColorBox2Change(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.CheckBox3Click(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.ColorBox3Change(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.ColorBox4Change(Sender: TObject);

begin

Paintbox1.Repaint;

end;

procedure TForm1.N2Click(Sender: TObject);

begin

Form3.ShowModal;

end;

procedure TForm1.N3Click(Sender: TObject);

begin

Form4.ShowModal;

end;

procedure TForm1.N4Click(Sender: TObject);

begin

Form5.ShowModal;

end;

procedure TForm1.N5Click(Sender: TObject);

begin

Form6.ShowModal;

end;

end.

Форма заставки:

unit Unit2;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls, OleCtnrs;

type

TForm2 = class(TForm)

Timer1: TTimer;

OleContainer1: TOleContainer;

Button1: TButton;

procedure Activate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.Activate(Sender: TObject);

Страницы: 1, 2, 3, 4