Im.Canvas.MoveTo(sm3,Round(ImH/2)+5);

Im.Canvas.LineTo(sm3,Round(ImH/2)-5);

sm3:=sm3-step;

// Вниз

Im.Canvas.MoveTo(Round(ImW/2)+5,sm4);

Im.Canvas.LineTo(Round(ImW/2)-5,sm4);

sm4:=sm4+step;

end;

Im.Canvas.TextOut(Round(ImW/2)+18,Round(ImH/2)+7,'1');

Im.Canvas.TextOut(Round(ImW/2)-11,Round(ImH/2)-27,'1');

Im.Canvas.TextOut(Round(ImW)-12,Round(ImH/2)+7,'X');

Im.Canvas.TextOut(Round(ImW/2)-11,7,'Y');

except

ShowMessage('error');

end;

end;

procedure TFMain.Clear();

begin

with FMain do

begin

Im.Canvas.Brush.Color := ClWhite;

Im.Canvas.FillRect(Canvas.ClipRect);

Ris;

MIter.Clear;

EU.Text:='';

EX.Text:='';

EY.Text:='';

EZ.Text:='';

EK.Text:='';

EXb.Text:='';

EYb.Text:='';

end;

end;

//---------------------------------------------

procedure TFMain.BClearClick(Sender: TObject);

begin

Clear();

end;

procedure TFMain.BExitClick(Sender: TObject);

begin

Close();

end;

procedure TFMain.BGaussClick(Sender: TObject);

var k, i, ostatok:Integer;

x0, y0, z0, x, y, z, _bez:Double; //a, b, c, d, e, f,

begin

if (RBx.Checked = false) and (RBy.Checked = false) then RBx.Checked := true;

try

if Miter.Count > 0 then MIter.Clear;

EU.Enabled := false;

k:=0;

Zapoln();

_bez:=(b*d-e*a)/(a*c-b*b);

EYb.Text:=floattostr(_bez);

EXb.Text:=floattostr(-(b*_bez+d)/a);

//-------------------------------

x:=StrToFloat(EX0.Text);

y:=StrToFloat(EY0.Text);

//z:=fz(x,y,a,b,c,d,e,f);

if RBx.Checked then ostatok := 1

else ostatok := 0;

for i := 1 to 1000 do

Begin

k:=i-1;

//-------------------Вывод-----------------------------------

MIter.Items.Add('---------------------');

MIter.Items.Add('k='+inttostr(k)+' | '+

'x'+inttostr(k)+'='+floattostr(x)+' | '+

'y'+inttostr(k)+'='+floattostr(y)+' | '+

'F(x,y)='+floattostr(z));

x0:=x;

y0:=y;

z0:=fz(x0,y0,a,b,c,d,e,f);

//------------------------------------------------------------

if (i mod 2) = ostatok then

Begin

x:=x0; //xi(y0,b,d,e);

y:=-(b*x0+e)/c;//yi(x0,b,e,c);

End

else

Begin

x:=-(b*y0+d)/a; //xi(y0,b,d,e);

y:=y0; //yi(x0,b,e,c);

End;

z:=fz(x,y,a,b,c,d,e,f);

//------------------------------------------------------------

if ((abs(x-x0)<0.01)and (abs(y-y0)<0.01) and (abs(z-z0)<0.01)) then break;

End;

EX.Text:=floattostr(x);

EY.Text:=floattostr(y);

EZ.Text:=floattostr(z);

EK.Text:=inttostr(k+1);

except

ShowMessage('Не удалось найти экстремум, попробуйте другой метод.');

end;

end;

procedure TFMain.BSpuskClick(Sender: TObject);

var k, i:Integer;

x0, y0, z0, x, y, z, Fx, Fy, M, _bez:Double; // a, b, c, d, e, f,

H : array[1..2,1..2] of Double;

begin

if (RBMin.Checked = false) and (RBMax.Checked = false) then RBMin.Checked := true;

if Miter.Count > 0 then MIter.Clear;

EU.Enabled := true;

k:=0;

Zapoln();

//-------------------------------

_bez:=(b*d-e*a)/(a*c-b*b);

EYb.Text:=floattostr(_bez);

EXb.Text:=floattostr(-(b*_bez+d)/a);

//-------------------------------

MIter.Items.Add('---------------------');

x:=StrToFloat(EX0.Text);

y:=StrToFloat(EY0.Text);

z:=fz(x,y,a,b,c,d,e,f);

MIter.Items.Add('k='+inttostr(k)+' '+

'x'+inttostr(k)+'='+floattostr(x)+' '+

'y'+inttostr(k)+'='+floattostr(y)+' '+

'F(x,y)='+floattostr(z));

H[1,1]:=2*a;

H[1,2]:=2*b;

H[2,1]:=2*b;

H[2,2]:=2*c;

for i := 1 to 1000 do

Begin

k:=k+1;

MIter.Items.Add('---------------------');

x0:=x;

y0:=y;

z0:=fz(x0,y0,a,b,c,d,e,f);

Fx:=dx(x0, y0, b, d, a);

Fy:=dy(x0, y0, b, e, c);

M:=(Fx*Fx + Fy*Fy)/(Fx*(H[1,1]*Fx+H[1,2]*Fy) + Fy*(H[2,1]*Fx+H[2,2]*Fy));

if RBMin.Checked then

begin

x:=x0-M*Fx;

y:=y0-M*Fy;

end

else if RBMax.Checked then

Begin

x:=x0+M*Fx;

y:=y0+M*Fy;

End;

z:=fz(x,y,a,b,c,d,e,f);

MIter.Items.Add('k='+inttostr(k)+' | '+

'x'+inttostr(k)+'='+floattostr(x)+' | '+

'y'+inttostr(k)+'='+floattostr(y)+' | '+

'F(x,y)='+floattostr(z)+' | '+

'u'+inttostr(k-1)+'='+floattostr(M));

if ((abs(x-x0)<0.01)and (abs(y-y0)<0.01) and (abs(z-z0)<0.01)) then break;

End;

EX.Text:=floattostr(x);

EY.Text:=floattostr(y);

EZ.Text:=floattostr(z);

EK.Text:=inttostr(k);

EU.Text:=floattostr(M);

end;

procedure TFMain.BStopClick(Sender: TObject);

begin

_BoolStop:=true;

end;

Function Znak(chislo : Double; Stroka:String) : String;

begin

if (chislo > 0) then

if (chislo <> 1) then Result:='+'+FloatToStr(chislo)+Stroka

else Result:='+'+Stroka

else if (chislo < 0) then

if (chislo <> -1) then Result:=FloatToStr(chislo)+Stroka

else Result:='-'+Stroka

else Result:='';

end;

Function ZnakN(chislo : Double; Stroka:String) : String;

begin

if (chislo > 0) then

if chislo <> 1 then Result:=FloatToStr(chislo)+Stroka

else Result:=Stroka

else if (chislo < 0) then

if (chislo <> -1) then Result:=FloatToStr(chislo)+Stroka

else Result:='-'+Stroka

else Result:='';

end;

Function ZnakKon(chislo : Double) : String;

begin

if (chislo > 0) then Result:='+'+FloatToStr(chislo)

else if chislo = 0 then Result:=''

else Result:=FloatToStr(chislo);

end;

procedure TFMain.Zapoln();

begin

with FMain do

begin

a:=DBGMain.Fields[1].AsFloat;

b:=DBGMain.Fields[2].AsFloat;

c:=DBGMain.Fields[3].AsFloat;

d:=DBGMain.Fields[4].AsFloat;

e:=DBGMain.Fields[5].AsFloat;

f:=DBGMain.Fields[6].AsFloat;

Am[1,1]:=DBGMain.Fields[9].AsFloat;

Am[1,2]:=DBGMain.Fields[10].AsFloat;

Bm[1]:=DBGMain.Fields[11].AsFloat;

Am[2,1]:=DBGMain.Fields[12].AsFloat;

Am[2,2]:=DBGMain.Fields[13].AsFloat;

Bm[2]:=DBGMain.Fields[14].AsFloat;

Am[3,1]:=DBGMain.Fields[15].AsFloat;

Am[3,2]:=DBGMain.Fields[16].AsFloat;

Bm[3]:=DBGMain.Fields[17].AsFloat;

Am[4,1]:=DBGMain.Fields[18].AsFloat;

Am[4,2]:=DBGMain.Fields[19].AsFloat;

Bm[4]:=DBGMain.Fields[20].AsFloat;

end;

end;

procedure TFMain.ZnakConstrain();

begin

with FMain do

begin

nomer:=StrToInt(EVar.Text);

Q.Close;

Q.SQL.Text:='select znak1, znak2, znak3, znak4 from Znaki where № = '+IntToStr(nomer);

Q.Open;

znak1:=Q.Fields.Fields[0].AsInteger;

znak2:=Q.Fields.Fields[1].AsInteger;

znak3:=Q.Fields.Fields[2].AsInteger;

znak4:=Q.Fields.Fields[3].AsInteger;

if znak1 = 0 then LC10.Caption:=Chr(8804)+' 0' // Chr(8805)

else LC10.Caption:=Chr(8805)+' 0';

if znak2 = 0 then LC20.Caption:=Chr(8804)+' 0'

else LC20.Caption:=Chr(8805)+' 0';

if znak3 = 0 then LC30.Caption:=Chr(8804)+' 0'

else LC30.Caption:=Chr(8805)+' 0';

if znak4 = 0 then LC40.Caption:=Chr(8804)+' 0'

else LC40.Caption:=Chr(8805)+' 0';

end;

end;

procedure TFMain.EVarChange(Sender: TObject);

begin

with FMain do

begin

Zapoln();

//-----------------------------------------------------------------------------------------------------//

with LFxy do

begin

Caption:='F(x,y)=';

Caption:=Caption+ZnakN(a,'x'+Chr(178));

Caption:=Caption+Znak(2*b,'xy');

Caption:=Caption+Znak(c,'y'+Chr(178));

Caption:=Caption+Znak(2*d,'x');

Caption:=Caption+Znak(2*e,'y');

Caption:=Caption+ZnakKon(f);

end;

//-----------------------------------------------------------------------------------------------------//

LC1.Caption:=ZnakN(Am[1,1],'x')+Znak(Am[1,2],'y')+ZnakKon(Bm[1]);

LC2.Caption:=ZnakN(Am[2,1],'x')+Znak(Am[2,2],'y')+ZnakKon(Bm[2]);

LC3.Caption:=ZnakN(Am[3,1],'x')+Znak(Am[3,2],'y')+ZnakKon(Bm[3]);

LC4.Caption:=ZnakN(Am[4,1],'x')+Znak(Am[4,2],'y')+ZnakKon(Bm[4]);

ZnakConstrain();

end;

end;

procedure TFMain.FormCreate(Sender: TObject);

var FileName, ConStr:String;

begin

FileName:='variants.mdb';//EFileName.Text; //

try

Conn.Connected:= false;

Conn.ConnectionString :=

'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+getCurrentDir+'\'+FileName+';'+

'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";Jet OLEDB:Registry Path="";'+

'Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;'+

'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;'+

'Jet OLEDB:Encrypt Database=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';

Conn.Connected:= true;

Conn.Open;

DBGMain.DataSource:=DSMain;

DataSetMain.Active:= false;

DataSetMain.CommandText :='select * from Варианты order by №';

DataSetMain.Active:= true;

DataSetMain.Open;

except

ShowMessage('Не удалось подключиться к базе вариантов. Вложите базу "variants.mdb" с вариантами в папку с программой.');

end;

//--------------------------------------------------------------------

ZnakConstrain();

//--------------------------------------------------------------------

Ris;

end;

Function Znak0(str : String) : String;

begin

if str = Chr(8804)+' 0' then Result:= Chr(8805)+' 0'

else Result:= Chr(8804)+' 0';

end;

Function ZnakUpdate(str : String) : Integer;

begin

if str = Chr(8804)+' 0' then Result:= 0

else Result:= 1;

end;

procedure TFMain.LC10Click(Sender: TObject);

begin

LC10.Caption:=Znak0(LC10.Caption);

end;

procedure TFMain.LC20Click(Sender: TObject);

begin

LC20.Caption:=Znak0(LC20.Caption);

end;

procedure TFMain.LC30Click(Sender: TObject);

begin

LC30.Caption:=Znak0(LC30.Caption);

end;

procedure TFMain.LC40Click(Sender: TObject);

begin

LC40.Caption:=Znak0(LC40.Caption);

end;

procedure TFMain.SaveZnakClick(Sender: TObject);

Var zi:Integer;

begin

with FMain do

try

nomer:=StrToInt(EVar.Text);

znak1:=ZnakUpdate(LC10.Caption);

znak2:=ZnakUpdate(LC20.Caption);

znak3:=ZnakUpdate(LC30.Caption);

znak4:=ZnakUpdate(LC40.Caption);

Q.Close;

Q.SQL.Text:='update Znaki set znak1='+IntToStr(znak1)

+', znak2='+IntToStr(znak2)

+', znak3='+IntToStr(znak3)

+', znak4='+IntToStr(znak4)

+' where №='+IntToStr(nomer);

Q.ExecSQL;

ShowMessage('Знаки успешно сохранены.');

except

ShowMessage('Не сохранить записать знаки.');

end;

end;

function RoundEx(chislo: double): double;

begin

RoundEx := (Round(chislo*1000))/1000;

end;

Function ZnakConst(str1, str2, str3 : String; X, Y :Double) : Integer;

Var zn1, zn2, zn3:Integer;

begin

zn1:=0; zn2:=0; zn3:=0;

if ((str1 = Chr(8804)+' 0') and (RoundEx(Am[1,1]*X+Am[1,2]*Y+Bm[1]) <= 0)) or

((str1 = Chr(8805)+' 0') and (RoundEx(Am[1,1]*X+Am[1,2]*Y+Bm[1]) >= 0)) then zn1:=1;

if ((str2 = Chr(8804)+' 0') and (RoundEx(Am[2,1]*X+Am[2,2]*Y+Bm[2]) <= 0)) or

((str2 = Chr(8805)+' 0') and (RoundEx(Am[2,1]*X+Am[2,2]*Y+Bm[2]) >= 0)) then zn2:=1;

if ((str3 = Chr(8804)+' 0') and (RoundEx(Am[3,1]*X+Am[3,2]*Y+Bm[3]) <= 0)) or

((str3 = Chr(8805)+' 0') and (RoundEx(Am[3,1]*X+Am[3,2]*Y+Bm[3]) >= 0)) then zn3:=1;

Result:=zn1+zn2+zn3;

end;

function FindMin(a:Mass):Double;

var

i,temp:integer;

begin

temp:=1;

for i := 1 to 10 do

if (a[i]<a[temp]) and (a[i]<>0) then

temp:=i;

Result:=a[temp]

end;

procedure TFMain.GaussSystem(N:Integer);

var g: Matrix;

bg, xv: Vector;

h: Double;

i,j,k,ns,gi, gN, Fn, ImW, ImH, ms:integer;

str:String;

begin

ms:=StrToInt(ESkor.Text);

ImW:=Im.Width;

ImH:=Im.Height;

//Ввод данных

//Размерность системы

ns := 3;

Zapoln();

MIter.Items.Add(' ');

MIter.Items.Add('------------------------------------ м. Множителей лагранжа: ------------------------------------');

if N=3 then begin gN:=3;Fn:=3; end

else gN:=4;Fn:=6;

for gi := 1 to gN do

begin

if _BoolStop = true then break;

//Коэффициенты

g[1,1]:= 2*a;

g[1,2]:= 2*b;

g[1,3]:= Am[gi,1];

g[2,1]:= 2*b;

g[2,2]:= 2*c;

g[2,3]:= Am[gi,2];

g[3,1]:= Am[gi,1];

g[3,2]:= Am[gi,2];

g[3,3]:= 0;

//Правая часть уравнения

bg[1]:= -2*d;

bg[2]:= -2*e;

bg[3]:= -Bm[gi];

//Прямой ход - исключение переменных

for i:=1 to ns-1 do

for j:=i+1 to ns do

begin

g[j,i]:=-g[j,i]/g[i,i];

for k:=i+1 to ns do

g[j,k]:=g[j,k]+g[j,i]*g[i,k];

bg[j]:=bg[j]+g[j,i]*bg[i];

end;

xv[ns]:=bg[ns]/g[ns,ns];

//Обратный ход - нахождение корней

for i:=ns-1 downto 1 do

begin

h:=bg[i];

for j:=i+1 to ns do h:=h-xv[j]*g[i,j];

xv[i]:=h/g[i,i];

end;

Xm[Fn+gi]:= xv[1];

Ym[Fn+gi]:= xv[2];

//-------------Рисование точек-----------------------------//

xr:=Round(ImW/2)+Round(Xm[Fn+gi]*20);;

yr:=Round(ImH/2)-Round(Ym[Fn+gi]*20);

Im.Canvas.Pen.Width:=2;

FMain.Im.Canvas.Pen.Color := clBlue;

FMain.Im.Canvas.Ellipse(xr-3, yr-3, xr + 3, yr + 3);

Im.Canvas.TextOut(xr+10,yr-10,'L'+inttostr(gi));

Delay(ms);

//Вывод результата

if ZnakConst(LC10.Caption, LC20.Caption, LC30.Caption, xv[1], xv[2]) = 3 then

begin

str:=' - Входит в область определения';

Fm[Fn+gi]:=fz(xv[1],xv[2],a,b,c,d,e,f);

end

else

begin

str:=' - Не входит в область определения';

Fm[Fn+gi]:=9999;

end;

MIter.Items.Add('x'+IntToStr(gi)+ '='+FloatToStr(xv[1])+' | y'+IntToStr(gi)+'='+FloatToStr(xv[2])+' | F(x,y)='+FloatToStr(fz(xv[1],xv[2],a,b,c,d,e,f)) + str);

end;

end;

procedure TFMain.BSimplexClick(Sender: TObject);

Var si, ssi, N, ImW, ImH, ms, yris, xris, NL:Integer; X, Y : array[1..10] of Double;

xg, yg, kg, bg, Xp, Yp:Double;

begin

_BoolStop:=False;

Clear();

ms:=StrToInt(ESkor.Text);

ImW:=Im.Width;

ImH:=Im.Height;

Zapoln();

if (LC4.Caption = '0') or (LC4.Caption = '') then

try

Begin

N:=3;

NL:=3;

for si := 2 to N do

begin

Ym[si-1]:=(Am[si,1]*Bm[1]-Am[1,1]*Bm[si])/(Am[si,2]*Am[1,1]-Am[si,1]*Am[1,2]);

Xm[si-1]:=(Bm[si]*Am[1,2]-Bm[1]*Am[si,2])/(Am[1,1]*Am[si,2]-Am[si,1]*Am[1,2]);//(-Bm[1]-Am[1,2]*Ym[si-1])/Am[1,1];

end;

for si := 3 to N do

begin

Ym[si]:=(Am[si,1]*Bm[2]-Am[2,1]*Bm[si])/(Am[si,2]*Am[2,1]-Am[si,1]*Am[2,2]);

Xm[si]:=(Bm[si]*Am[2,2]-Bm[2]*Am[si,2])/(Am[2,1]*Am[si,2]-Am[si,1]*Am[2,2]);//(-Bm[2]-Am[2,2]*Ym[si])/Am[2,1];

end;

End;

except

ShowMessage('А-юй!');

end

else

Begin

N:=6;

NL:=4;

for si := 2 to N-2 do

begin

Ym[si-1]:=(Am[si,1]*Bm[1]-Am[1,1]*Bm[si])/(Am[si,2]*Am[1,1]-Am[si,1]*Am[1,2]);

Xm[si-1]:=(Bm[si]*Am[1,2]-Bm[1]*Am[si,2])/(Am[1,1]*Am[si,2]-Am[si,1]*Am[1,2]);//(-Bm[1]-Am[1,2]*Ym[si-1])/Am[1,1];

end;

for si := 3 to N-2 do

begin

Ym[si+1]:=(Am[si,1]*Bm[2]-Am[2,1]*Bm[si])/(Am[si,2]*Am[2,1]-Am[si,1]*Am[2,2]);

Xm[si+1]:=(Bm[si]*Am[2,2]-Bm[2]*Am[si,2])/(Am[2,1]*Am[si,2]-Am[si,1]*Am[2,2]);//(-Bm[2]-Am[2,2]*Ym[si-1])/Am[2,1];

end;

Ym[6]:=(Am[4,1]*Bm[3]-Am[3,1]*Bm[4])/(Am[4,2]*Am[3,1]-Am[4,1]*Am[3,2]);

Xm[6]:=(Bm[4]*Am[3,2]-Bm[3]*Am[4,2])/(Am[3,1]*Am[4,2]-Am[4,1]*Am[3,2]);//(-Bm[3]-Am[3,2]*Ym[6])/Am[3,1];

End;

//----------------------------------------------------------------------------------------------

MIter.Items.Add('------------------------------------ Граничные точки области определения: ------------------------------------');

for si := 1 to NL do

begin

if _BoolStop = true then break;

//-------------Рисование прямых-----------------------------//

FMain.Im.Canvas.Pen.Color := clMaroon;

Im.Canvas.Pen.Width:=1;

if Am[si,2] = 0 then

if Bm[si] = 0 then

begin

xris:=Round(ImW/2);

yris:=Round(ImH/2-100);

Im.Canvas.MoveTo(xris,yris);

yris:=Round(ImH/2+100);

Im.Canvas.LineTo(xris,yris);

end

else

begin

xris:=Round(ImW/2-Bm[si]*20);

yris:=Round(ImH/2-100);

Im.Canvas.MoveTo(xris,yris);

yris:=Round(ImH/2+100);

Im.Canvas.LineTo(xris,yris);

end

else if Am[si,1] = 0 then

if Bm[si] = 0 then

begin

yris:=Round(ImH/2);

xris:=Round(ImW/2+100);

Im.Canvas.MoveTo(xris,yris);

xris:=Round(ImW/2)-100;

Im.Canvas.LineTo(xris,yris);

end

else

begin

yris:=Round(ImH/2+Bm[si]*20);

xris:=Round(ImW/2+100);

Im.Canvas.MoveTo(xris,yris);

xris:=Round(ImW/2)-100;

Im.Canvas.LineTo(xris,yris);

end

else

begin

kg:=-Am[si,1]/Am[si,2];

bg:=-Bm[si]/Am[si,2];

xris:=Round(ImW/2+200);

yris:=(Round(ImH/2)-Round((kg*10+bg)*20));

Im.Canvas.MoveTo(xris,yris);

xris:=Round(ImW/2)-100;

yris:=(Round(ImH/2)-Round((kg*(-5)+bg)*20));

Im.Canvas.LineTo(xris,yris);

end;

Delay(ms);

end;

//----------------------------------------------------------//

for si := 1 to N do

begin

if _BoolStop = true then break;

Fm[si]:=fz(Xm[si],Ym[si],a,b,c,d,e,f);

//-------------Рисование точек-----------------------------//

xr:=Round(ImW/2)+Round(Xm[si]*20);

yr:=Round(ImH/2)-Round(Ym[si]*20);

Im.Canvas.Pen.Width:=2;

FMain.Im.Canvas.Pen.Color := clRed;

FMain.Im.Canvas.Ellipse(xr-3, yr-3, xr + 3, yr + 3);

Im.Canvas.TextOut(xr+10,yr-10,'A'+inttostr(si));

Delay(ms);

//------------------------------------------------------//

MIter.Items.Add('x'+inttostr(si)+'='+floattostr(Xm[si])+' | y'+inttostr(si)+'='+floattostr(Ym[si])+' | F(x,y)='+FloatToStr(Fm[si]));

end;

//------------------ Обвести область-----------------------------------------------------------

for si := 1 to N do

begin

for ssi:=si to N do

begin

if _BoolStop = true then break;

Xp:=Xm[ssi]; Yp:=Ym[ssi];

if (ZnakConst(LC10.Caption, LC20.Caption, LC30.Caption, Xp, Yp) = 3)

and (ZnakConst(LC10.Caption, LC20.Caption, LC30.Caption, Xm[si], Ym[si]) = 3)

and (ZnakConst(LC10.Caption, LC20.Caption, LC30.Caption, (Xm[si]+Xp)/2, (Ym[si]+Yp)/2) = 3) then

begin

xr:=Round(ImW/2)+Round(Xp*20);

yr:=Round(ImH/2)-Round(Yp*20);

Im.Canvas.Pen.Width:=2;

FMain.Im.Canvas.Pen.Color := clRed;

Im.Canvas.MoveTo(xr,yr);

xr:=Round(ImW/2)+Round(Xm[si]*20);

yr:=Round(ImH/2)-Round(Ym[si]*20);

Im.Canvas.LineTo(xr,yr);

Xp:=Xm[si]; Yp:=Ym[si];

Delay(ms);

end;

end;

end;

//----------------------------------------------------------------------------------------------

GaussSystem(N);

for si := 1 to 10 do

begin

if _BoolStop = true then break;

if FindMin(Fm) = Fm[si] then

begin

MIter.Items.Add(' ');

MIter.Items.Add('Ответ: F(x,y)='+FloatToStr(Fm[si])+' x='+FloatToStr(Xm[si])+' y='+FloatToStr(Ym[si]));

end;

end;

end;

procedure TFMain.BSoprClick(Sender: TObject);

var k, i, ImW, ImH, r, yris, xris, ms:Integer;

x0, y0, z0, x, y, z, Fx, Fy, M, _bez, xg, yg, kg,bg:Double;

H : array[1..2,1..2] of Double;

S, S0, sp : array[1..2] of Double;

begin

_BoolStop:=False;

Clear();

if (RBMin.Checked = false) and (RBMax.Checked = false) then RBMin.Checked := true;

if Miter.Count > 0 then MIter.Clear;

EU.Enabled := true;

ms:=StrToInt(ESkor.Text);

ImW:=Im.Width;

ImH:=Im.Height;

k:=0;

Zapoln();

//-------------------------------

_bez:=(b*d-e*a)/(a*c-b*b);

EYb.Text:=floattostr(_bez);

EXb.Text:=floattostr(-(b*_bez+d)/a);

Im.Canvas.Pen.Color:=clred;

Im.Canvas.Pen.Width:=2;

xr :=Round(ImW/2)+Round(StrToFloat(EXb.Text)*20);

yr :=Round(ImH/2)-Round(StrToFloat(EYb.Text)*20);

FMain.Im.Canvas.Pen.Color := clBlue;

FMain.Im.Canvas.Ellipse(xr-4, yr-4, xr + 4, yr + 4);

Delay(ms);

Im.Canvas.TextOut(xr+10,yr-10,'Aб');

Delay(ms);

//----------------------------------------------------------------------------

MIter.Items.Add('---------------------');

x:=StrToFloat(EX0.Text);

y:=StrToFloat(EY0.Text);

z:=fz(x,y,a,b,c,d,e,f);

//----------------------------------------------------------------------------

MIter.Items.Add('k='+inttostr(k)+' | '+

'x'+inttostr(k)+'='+floattostr(x)+' | '+

'y'+inttostr(k)+'='+floattostr(y)+' | '+

'F(x,y)='+floattostr(z));

//----------------------------------------------------------------------------

xr:=Round(ImW/2)+Round(StrToFloat(EX0.Text)*20);;

yr:=Round(ImH/2)-Round(StrToFloat(EY0.Text)*20);

FMain.Im.Canvas.Pen.Color := clRed;

FMain.Im.Canvas.Ellipse(xr-2, yr-2, xr + 2, yr + 2);

Delay(ms);

Im.Canvas.TextOut(xr-16,yr-10,'Ao');

Delay(ms);

// Гессиан

H[1,1]:=2*a;

H[1,2]:=2*b;

H[2,1]:=2*b;

H[2,2]:=2*c;

// Направление

S[1]:=1;

S[2]:=1;

// Цикл рассчета метода

for i := 1 to 1000 do

Begin

if _BoolStop = true then break;

k:=k+1;

MIter.Items.Add('---------------------');

x0:=x;

y0:=y;

z0:=fz(x0,y0,a,b,c,d,e,f);

Fx:=dx(x0, y0, b, d, a);

Fy:=dy(x0, y0, b, e, c);

S0[1]:=S[1];

S0[2]:=S[2];

// Находим u

M:=(Fx*S0[1] + Fy*S0[2])/(S0[1]*(H[1,1]*S0[1]+H[1,2]*S0[2]) + S0[2]*(H[2,1]*S0[1]+H[2,2]*S0[2]));

sp[1]:=H[1,1]*S0[1]+H[1,2]*S0[2];

sp[2]:=H[2,1]*S0[1]+H[2,2]*S0[2];

S[1]:=sp[2];

S[2]:=-sp[1];

if RBMin.Checked then

begin

x:=x0-M*S0[1];

y:=y0-M*S0[2];

end

else if RBMax.Checked then

Begin

x:=x0+M*S0[1];

y:=y0+M*S0[2];

End;

MIter.Items.Add('S'+inttostr(k-1)+'('+floattostr(S0[1])+','+floattostr(S0[2])+')');

z:=fz(x,y,a,b,c,d,e,f);

//------------------ Вывод на экран ---------------------------------------

MIter.Items.Add('k='+inttostr(k)+' | '+

'x'+inttostr(k)+'='+floattostr(x)+' | '+

'y'+inttostr(k)+'='+floattostr(y)+' | '+

'F(x,y)='+floattostr(z)+' | '+

'u'+inttostr(k-1)+'='+floattostr(M));

// условие выхода из цикла

if ((abs(x-x0)<0.01)and (abs(y-y0)<0.01) and (abs(z-z0)<0.01)) then break;

// Промежуточные точки

xr:=Round(ImW/2)+Round(x*20);;

yr:=Round(ImH/2)-Round(y*20);

Im.Canvas.Pen.Width:=2;

FMain.Im.Canvas.Pen.Color := clOlive;

FMain.Im.Canvas.Ellipse(xr-2, yr-2, xr + 2, yr + 2);

Delay(ms);

// Уравнение прямой и рисование направления

xg:=x+S0[1];

yg:=y+S0[2];

kg:=(yg-y)/(xg-x);

bg:=yg-kg*xg;

FMain.Im.Canvas.Pen.Color := clBlack;

Im.Canvas.Pen.Width:=1;

yris:=(Round(ImH/2)-Round((kg*5+bg)*20));

Im.Canvas.MoveTo(Round(ImW/2+100),yris);

yris:=(Round(ImH/2)-Round((kg*(-5)+bg)*20));

Im.Canvas.LineTo(Round(ImW/2)-100,yris);

Delay(ms);

End;

EX.Text:=floattostr(x);

EY.Text:=floattostr(y);

EZ.Text:=floattostr(z);

EK.Text:=inttostr(k);

EU.Text:=floattostr(M);

end;

end.

Размещено на Allbest.ru