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.