Код для формы Form2

unit Unit2;

{$mode objfpc}{$H+}

interface

uses

Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,

ComCtrls, Buttons, StdCtrls, Menus;

type

{ TForm2 }

TForm2 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Edit7: TEdit;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

MainMenu1: TMainMenu;

Memo1: TMemo;

MenuItem1: TMenuItem;

MenuItem10: TMenuItem;

MenuItem11: TMenuItem;

MenuItem2: TMenuItem;

MenuItem3: TMenuItem;

MenuItem4: TMenuItem;

MenuItem5: TMenuItem;

MenuItem6: TMenuItem;

MenuItem7: TMenuItem;

MenuItem8: TMenuItem;

MenuItem9: TMenuItem;

SaveDialog1: TSaveDialog;

OpenDialog1: TOpenDialog;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

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

procedure FormCreate(Sender: TObject);

procedure MenuItem10Click(Sender: TObject);

procedure MenuItem11Click(Sender: TObject);

procedure MenuItem2Click(Sender: TObject);

procedure MenuItem3Click(Sender: TObject);

procedure MenuItem4Click(Sender: TObject);

procedure MenuItem6Click(Sender: TObject);

procedure MenuItem7Click(Sender: TObject);

procedure MenuItem9Click(Sender: TObject);

procedure TrackBar1Change(Sender: TObject);

private

{ private declarations }

public

{ public declarations }

end;

var

Form2: TForm2;

lgr,rgr,e, i0: real;

lgr_viz,rgr_viz,pribl: real;

koren: array [1..100] of real;

prov, viz:boolean;

n: integer;

b,x: array [1..10] of real;

f: textfile;

path: string;

MinX, MaxX: real;

MinY, MaxY: real;

ScrWidth,ScrHeight,w,h: integer;

implementation

uses Unit3,Unit4,Unit5;

{ TForm2 }

Function I(t:real): real; //функция тока

begin

I:=i0*(sin(t)-cos(2*t))/(t+3);

end;

Function dI(t:real): real; //функция тока

begin

dI:=(i0*(cos(t)+2*sin(2*t))/(t+3))-(i0*(sin(t)-cos(2*t))/((t+3)*(t+3)));

end;

function Power(a, b: real): real; {a^b}

Begin

if a=0 then

Power:=0

Else

Begin

if (a > 0) then

Power:=Exp(Ln(a)*b)

Else

Power:=-Exp(Ln(-a)*b);

End;

End;

function solve(x0:real; eps: real): real;

var

x: real;

a: real;

ch: integer;

begin

x:=x0;

a:= I(x)/dI(x);

ch:=0;

while Abs(a)>eps do

begin

ch:=ch+1; //защита от зацикливания - не более 1000 итераций

x:= x-a;

a:= I(x)/dI(x);

If (ch=1000) Then

begin

MessageDlg('Заданная вами точность не достигнута ', mtError, [mbOK], 0);

break;

end;

end;

solve:= x;

end;

procedure grfic(lgr,rgr: real);

var

imgW, imgh, x0,y0, x_centr, y_centr,pvx,pvy: integer;

mx,my,t, x, x1,y, y1, MinY,MaxY, hag,buf:real;

s: string;

{for vizualizacii }

x_1, X_2,y_1,Y_2: integer;

begin

form3.Show;

imgW:= form3.Image1.Width;

imgh:= form3.Image1.Height;

with form3.Image1.Canvas do

begin //

FillRect(Rect(0,0,2*form3.Image1.Width,2*form3.Image1.Height));

Font.Color:=clBlack;

{nachalnie ustanovki}

x0:=Round(0.1* imgW);

y0:=Round(0.1* imgh);

imgW:=Round(imgW*0.8);

imgh:=Round(imgh*0.8);

{poisk max i min po osi y}

t:= (rgr-lgr)/1000;

x:= lgr;

MinY:= I(x);

MaxY:= I(x);

While (x <= rgr) Do

Begin

x:= x+t;

y:= I(x);

if MinY > y then MinY:= y;

if MaxY < y then MaxY:= y;

End;

{mashtabi po x i y}

mx:= imgW/(rgr-lgr);

if (MaxY>0) and (MinY<=0)then my:= imgh/(MaxY-MinY);

if (MaxY>0) and (MinY>0)then my:= imgh/(MaxY);

if (MaxY<=0) and (MinY<0)then my:= imgh/(abs(MinY));

{jpredelenie polojenij centra}

x_centr:=x0;

if (MinY<0) and (MaxY<=0) then y_centr:=round(y0);

if (MinY<=0) and (MaxY>0) then y_centr:=round(y0+ abs(MaxY)*my);

if (MinY>0) and (MaxY>0) then y_centr:=round(y0+imgh);

{stroica grafica}

Pen.Style:=pssolid; Pen.color:=clRed;

x:= lgr;

Y:= I(x);

x1:=lgr;

While (x1 <= rgr-t) Do

Begin

x1:= x1+t;

y1:= I(x1);

MoveTo(Round(x_centr+(x-lgr)*mx), Round(y_centr-y*my));

LineTo(Round(x_centr+(x1-lgr)*mx), Round(y_centr-y1*my));

x:=x1;

y:=y1;

End;

{osi x i y}

Pen.color:=clBlack;

MoveTo(0, y_centr);

LineTo(round(imgW/0.8), y_centr);

MoveTo(x_centr, 0);

LineTo(x_centr, Round(imgh/0.8));

{opredelinie porjdka velichin osi X}

x:=rgr-lgr;

if x>1 then

begin

pvx:=Trunc(ln(x)/(ln(9.99)));

end;

if x<=1 then

begin

pvx:=-Trunc(abs(ln(x)/(ln(9.99))))-1;

end;

if ((x/(power(10,pvx))>5)) then hag:=1;

if x/(power(10,pvx))<=2.5 then hag:=0.25;

if (x/(power(10,pvx))>2.5) and (x/(power(10,pvx))<=5) then hag:=0.5;

{risovca setki osi x}

Pen.Style:=psDot;

x:= lgr;

Font.Color:=clBlue;

While (x <= rgr) Do

Begin

x:=x+hag*power(10,pvx);

MoveTo(Round(x_centr+(x-lgr)*mx),0);

LineTo(Round(x_centr+(x-lgr)*mx), Round(imgh/0.8));

TextOut(round(x_centr+(x-lgr)*mx+9), y_centr+9, floattostr(x/power(10,pvx)));

End;

s:='t' + '*10^' +floattostr(pvx);

TextOut(round(imgW/0.8)-70, y_centr-25, s);

{opredelinie porjdka velichin osi Y}

if abs(MinY)>abs(MaxY) then y:=abs(MinY)

else y:=abs(MaxY);

if y>1 then

begin

pvy:=Trunc(ln(y)/(ln(9.99)));

end;

if y<=1 then

begin

pvy:=-Trunc(abs(ln(y)/(ln(9.99))))-1;

end;

if ((y/(power(10,pvy))>5)) then hag:=1;

if y/(power(10,pvy))<=2.5 then hag:=0.25;

if (y/(power(10,pvy))>2.5) and (y/(power(10,pvy))<=5) then hag:=0.5;

{risovca setki osi Y}

Font.Color:=clRed;

y:= 0;

While (y <= MaxY) Do

Begin

y:=y+hag*power(10,pvy);

MoveTo(0,Round(y_centr-y*my));

LineTo(Round(imgw/0.8), Round(y_centr-y*my));

TextOut(x_centr+10, Round(y_centr-y*my)-10, floattostr(y/power(10,pvy)));

End;

y:= 0;

While (y >= minY) Do

Begin

y:=y-hag*power(10,pvy);

MoveTo(0,Round(y_centr-y*my));

LineTo(Round(imgw/0.8), Round(y_centr-y*my));

TextOut(x_centr+10, Round(y_centr-y*my)-10, floattostr(y/power(10,pvy)));

End;

s:='I' + '*10^' +floattostr(pvy);

TextOut(x_centr+50, 10, s);

Font.Color:=clRed;

TextOut(x_centr+10, y_centr-20, '0'); {nachalo otscheta po osi Y}

s:=floattostr(lgr/power(10,pvx));

Font.Color:=clBlue;

TextOut(round(x_centr+9), y_centr+9, s); {nachalo otscheta po osi X}

if viz=true then

begin

Pen.Style:=pssolid;

Brush.Style:= bsSolid;

Brush.Color:= clGreen;

x1:=pribl;

repeat

X:= x1 - (i(x1) / di(x1));

Pen.Color:=clGreen;

x_1:=x_centr+Round((x1-lgr)*mX);

x_2:=x_centr+Round((x-lgr)*mX);

y_1:=Round(y_centr-i(x1)*my);

y_2:=Round(y_centr-0*my);

MoveTo(x_1,y_1);

lineto(x_2,y_2);

Ellipse(x_centr+Round((x1-lgr)*mX-3),Round(y_centr-i(x1)*my)-3, x_centr+Round((x1-lgr)*mX)+3,Round(y_centr-i(x1)*my)+3);

Pen.Color:=clblue;

x_1:=x_centr+Round((x-lgr)*mX);

x_2:=x_centr+Round((x-lgr)*mX);

y_1:=Round(y_centr-i(x)*my);

y_2:=Round(y_centr-0*my);

MoveTo(x_1,y_1);

lineto(x_2,y_2);

buf:=x1;

x1:=X;

Until (Abs(X - buf)<= e);

Brush.Color:= clWhite;

end;

end;//

end;

procedure vvod;

begin

prov:=true;

lgr:=strtofloat(form2.edit2.Text);

rgr:=strtofloat(form2.edit3.Text);

e:=strtofloat(form2.edit1.Text);

i0:=strtofloat(form2.edit4.Text);

pribl:=strtofloat(form2.edit5.Text);

lgr_viz:=strtofloat(form2.edit6.Text);

rgr_viz:=strtofloat(form2.edit7.Text);

If (Lgr >= Rgr) or (Lgr_viz >= Rgr_viz) Then

begin

MessageDlg('Левая граница не может быть больше правой или равна ей', mtError, [mbOK], 0);

prov:= False;

End;

If (Lgr <0) or (Lgr_viz <0) Then

begin

MessageDlg('Время не может быть отрицательное!', mtError, [mbOK], 0);

prov:= False;

End;

If i0=0 Then

begin

MessageDlg('I0 не должен быть 0!', mtError, [mbOK], 0);

prov:= False;

End;

If (e<=0) Then

begin

MessageDlg('Точность не может быть меньше или = 0', mtError, [mbOK], 0);

prov:= False;

end;

end;

procedure Poisk_smeni;

var j: integer;

t,x: real;

begin

if prov=true then

begin

form2.memo1.Clear;

t:= Abs((rgr-lgr)/100);

x:=lgr;

j:=0;

While (x <= (rgr - t)) Do

Begin

if (i(x)*i(x+t)<0) then

begin

j:=j+1;

if j=1 then form2.memo1.Lines.add('На интервале обнаружены точки смены знака:');

if i(x)<0 then form2.memo1.Lines.add('Смена А "-" на "+" = '+floattostrf(solve(x,e),fffixed,5,5)+ 'sec')

else form2.memo1.Lines.add('Смена Б "+" на "-" = '+floattostrf(solve(x,e),fffixed,5,5)+ 'sec');

end;

x:= x+t;

End;

if j=0 then form2.memo1.Lines.add('Смены знаков не обнаружено!');

end;

end;

procedure TForm2.Button1Click(Sender: TObject);

begin

vvod;

If (prov=true) Then

begin

Button2.Enabled:=true;

Button3.Enabled:=true;

MessageDlg('Введены коректные данные вазможно продолжение работы!', mtInformation, [mbyes], 0);

End;

end;

procedure TForm2.Button2Click(Sender: TObject);

begin

Poisk_smeni;

end;

procedure TForm2.Button3Click(Sender: TObject);

begin

if prov=true then

begin

grfic(lgr,rgr);

end;

end;

procedure TForm2.Button4Click(Sender: TObject);

begin

form4.Show;

end;

procedure TForm2.Button5Click(Sender: TObject);

begin

if prov=true then

begin

viz:=true;

grfic(lgr_viz, rgr_viz);

viz:=false;

end;

end;

procedure TForm2.FormClose(Sender: TObject; var CloseAction: TCloseAction);

begin

Application.MainForm.Close;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

viz:=false;

end;

procedure TForm2.MenuItem10Click(Sender: TObject);

begin

Form2.Button5.Click;

end;

procedure TForm2.MenuItem11Click(Sender: TObject);

begin

form5.show;

end;

procedure TForm2.MenuItem2Click(Sender: TObject);

var

tx: string; fl: textfile;

begin

{$I-}

path:='zagr.txt';

assignfile(fl, path);

reset(fl);

readln(fl,tx);

edit1.text:=tx;

readln(fl, tx);

edit2.text:=tx;

readln(fl, tx);

edit3.text:=tx;

closefile(fl);

{$I+}

if IOresult<>0 then showmessage('ошибка при открытии файла: Либо поврежден либо отсутствует.');

end;

procedure TForm2.MenuItem3Click(Sender: TObject);

var

tx: string; i: integer; fl: textfile;

begin

if (prov=true) then

begin

{$I-}

assignfile(fl, 'save.txt');

rewrite(fl);

tx:=' ****** Отчет по вычислениям ****** ';

writeln(fl, tx);

tx:='Левая граница= ' + floattostr(lgr);

writeln(fl, tx);

tx:='правая граница = ' + floattostr(rgr);

writeln(fl, tx);

tx:=' Точность = ' + floattostr(e);

writeln(fl, tx);

tx:='I0= ' + floattostr(i0);

writeln(fl, tx);

for i:=1 to n do

begin

tx:='Корень = ' + floattostr(koren[i]);

writeln(fl, tx);

end;

closefile(fl);

{$I+}

if IOresult<>0 then showmessage('файла Либо поврежден либо отсутствует.');

end;

end;

procedure TForm2.MenuItem4Click(Sender: TObject);

begin

Application.MainForm.Close;

end;

procedure TForm2.MenuItem6Click(Sender: TObject);

begin

Form2.Button3.Click;

end;

procedure TForm2.MenuItem7Click(Sender: TObject);

begin

Form2.Button2.Click;

end;

procedure TForm2.MenuItem9Click(Sender: TObject);

begin

Form2.Button4.Click;

end;

procedure TForm2.TrackBar1Change(Sender: TObject);

begin

end;

initialization

{$I unit4.lrs}

{$I unit2.lrs}

{$I unit3.lrs}

{$I unit5.lrs}

end.

Дата добавления: 2015-08-05