unit URoot2;
// Решение систем уравнений
// Уравнения системы записываются в виде:
// имя_функции = выражение с переменными
// имя_функции - это произвольное имя, начинающееся
// с символа "f".
// Имена переменных произвольные,
// но не начинающиеся с символа "f".
// Для метода Ньютона ищутся корни,
// обращающие все выражения в 0.
// Для метода простых итераций ищутся корни, для которых
// значение первой функции равно значению первой переменной
// (в порядке появления переменных в выражениях),
// значение второй функции равно значению второй переменной
// и т.д.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, ToolWin, ActnList, ImgList, AppEvnts, Menus,
  Equ2, UMatrix;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Label5: TLabel;
    EDF: TEdit;
    RGMetod: TRadioGroup;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    EDAbsX: TEdit;
    Label4: TLabel;
    EDRelX: TEdit;
    MainMenu1: TMainMenu;
    MFile: TMenuItem;
    MOpen: TMenuItem;
    MSave: TMenuItem;
    N1: TMenuItem;
    MExit: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    ImageList1: TImageList;
    ActionList1: TActionList;
    AOpen: TAction;
    ASave: TAction;
    AExit: TAction;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton6: TToolButton;
    N4: TMenuItem;
    ARoot: TAction;
    ACalc: TAction;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton7: TToolButton;
    ATransl: TAction;
    N5: TMenuItem;
    ToolButton8: TToolButton;
    AFX0: TAction;
    N6: TMenuItem;
    ToolButton9: TToolButton;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    ENIterMax: TEdit;
    AHelp: TAction;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure ARootExecute(Sender: TObject);
    procedure AOpenExecute(Sender: TObject);
    procedure ASaveExecute(Sender: TObject);
    procedure ACalcExecute(Sender: TObject);
    procedure ATranslExecute(Sender: TObject);
    procedure AFX0Execute(Sender: TObject);
    procedure RGMetodClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AExitExecute(Sender: TObject);
    procedure ApplicationEvents1Hint(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AHelpExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Synt, UErrors, ShellAPI, UX0, UResult;

{$R *.DFM}

var NX: word;         // Размерность задачи
// AXName, AYName: динамические массивы имен переменных и функций;
    AXName, AYName: array of string;

function F(X: TVector; var Y: TVector; N: word): boolean;
var i: integer;
    A: real;
begin
 Inc(NIter);                         // Подсчет итераций
 for i := 0 to N - 1 do
  SetData(AXName[i],X[i]);
 if(not Calculate(A))
  then begin
   Application.MessageBox(
        'Ошибка вычисления функции',
        'Ошибка',MB_OK+MB_ICONSTOP);
   Result := false;
   exit;
  end;
 for i := 0 to N - 1 do
  GetData(AYName[i], Y[i]);
 Result := true;
end;

procedure TForm1.ATranslExecute(Sender: TObject);
var i, ix, iy: integer;
begin
 // Закрывается форма сообщений об ошибках
 if (FErrors <> nil) then FErrors.Close;
 // Закрывается форма задания начальных значений
 FX0.Visible := false;
 // Закрывается форма результатов
 FResult.Visible := false;
 ErrorMatrix := false;
 // Создается польская запись
 if not CreatePZ(Memo1.Text)
  then begin
// При ошибках трансляции показывается форма с сообщениями
   Application.CreateForm(TFErrors, FErrors);
   ErrorMatrix:= true;
   FErrors.LBErrors.Items.Assign(ErrorList);
   FErrors.Show;
   exit;
  end;
// Число переменных и имен функций как половина
// от общего числа идентификаторов
 if Odd(Length(DataList) - MConst)
  then begin
   Application.MessageBox(
                   'Число функций не равно числу переменных',
                   'Введите правильную информацию', MB_OK + MB_ICONSTOP);
   ErrorMatrix:= true;
   exit;
  end;

 NX := (Length(DataList) - MConst) div 2;
 SetLength(AXName, NX);
 SetLength(AYName, NX);
 if (NX <= 0)
  then begin
   Application.MessageBox(
                   'Во введенных выражениях нет имен переменных или функций',
                   'Введите правильную информацию', MB_OK + MB_ICONSTOP);
   ErrorMatrix:= true;
   exit;
  end;
 // Задание размерности таблицы начальных значений
 FX0.StringGrid1.RowCount := NX;
 // ix и iy - текущие индексы массивов имен переменных и функций
 ix := 0;
 iy := 0;
 // Заполнение  массивов имен переменных и функций,
 // а также таблицы начальных значений
 // с проверками совпадения числа переменных и функций
 for i := 0 to NX + NX - 1 do begin
  if (DataList[MConst + i].Name[1] = 'F')
   then begin
    if(iy = NX) then begin
     Application.MessageBox(
                   'Число функций превышает число переменных',
                   'Систему уравнений решить нельзя', MB_OK + MB_ICONSTOP);
     ErrorMatrix:= true;
     exit;
    end;
    AYName[iy] := DataList[MConst + i].Name;
    Inc(iy);
   end
   else begin
    if(ix = NX) then begin
     Application.MessageBox(
                   'Число переменных превышает число функций',
                   'Систему уравнений решить нельзя', MB_OK + MB_ICONSTOP);
     ErrorMatrix:= true;
     exit;
    end;
    AXName[ix] := DataList[MConst + i].Name;
    FX0.StringGrid1.Cells[0, ix] := AXName[ix];
    FX0.StringGrid1.Cells[1, ix] := '1';
    Inc(ix);
   end;
 end;
 if Sender = ATransl then
  Application.MessageBox(
              PChar('Число уравнений - ' + IntToStr(NX) +
              #13'Синтаксических ошибок не обнаружено'),
              'Трансляция успешно завершена',
              MB_OK + MB_ICONSTOP);

 // Показатель, что прежний текст уже оттранслирован
 Memo1.Modified := false;
end;

procedure TForm1.AFX0Execute(Sender: TObject);
begin
 // Если текст в окне Memo1 был изменен,
 // то вызывается трансляция
 if(Memo1.Modified)
  then ATranslExecute(Sender);
 if ErrorMatrix
  then exit;
 FX0.Visible := true;
end;

procedure TForm1.ARootExecute(Sender: TObject);
var i: integer;
    Good: boolean;
begin
 // Если текст в окне Memo1 был изменен,
 // то вызывается трансляция
 if(Memo1.Modified)
  then ATranslExecute(Sender);
 if ErrorMatrix
  then exit;
 SetLength(AX0, NX);
 try
  for i := 0 to NX -1 do
   AX0[i] := StrToFloat(FX0.StringGrid1.Cells[1, i]);
 except
  Application.MessageBox(
        'Неверный формат чисел в начальных значениях',
        'Исправьте ошибку',MB_OK+MB_ICONSTOP);
  FX0.Visible := true;
  exit;
 end;

 try
  DAbsX := Abs(StrToFloat(EDAbsX.Text));
  DRelX := Abs(StrToFloat(EDRelX.Text));
  DF := Abs(StrToFloat(EDF.Text));
  NIterMax := Abs(StrToInt(ENIterMax.Text));
 except
  Application.MessageBox(
        'Неверный формат чисел в заданных погрешностях',
        'Исправьте ошибку',MB_OK+MB_ICONSTOP);
  exit;
 end;
 if (DAbsX = 0) and (DRelX = 0) and (DF = 0)
  then begin
   Application.MessageBox(
        'Не задана информация о погрешностях',
        'Задайте информацию',MB_OK+MB_ICONSTOP);
   exit;
  end;
//  Func := F;
  case RGMetod.ItemIndex of
    0: Good := Nevton(NX);
    1: Good := Iterat(NX);
  end;
  if Good then begin
   FResult.StringGrid1.RowCount := NX;
   FResult.StringGrid2.RowCount := NX;
   for i := 0 to NX - 1 do begin
    FResult.StringGrid1.Cells[0, i] := AXName[i];
    FResult.StringGrid1.Cells[1, i] := FloatToStrF(AX[i],ffGeneral,7,0);
    FResult.StringGrid2.Cells[0, i] := AYName[i];
    FResult.StringGrid2.Cells[1, i] := FloatToStrF(AFDelta[i],ffGeneral,7,0);
   end;
   FResult.LIter.Caption := IntToStr(NIter);
   FResult.Visible := true;
  end
  else
    Application.MessageBox(
        'Смените исходные данные или метод',
        'Расчет невозможен',MB_OK+MB_ICONSTOP);
end;

procedure TForm1.AOpenExecute(Sender: TObject);
// Открыте файла и загрузка текста в Memo1
begin
 if(OpenDialog1.Execute)
  then begin
   Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
   Memo1.Modified := true;
  end;
end;

procedure TForm1.ASaveExecute(Sender: TObject);
// Сохранение текста в файле
begin
 if(SaveDialog1.Execute)
  then Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.ACalcExecute(Sender: TObject);
// Вызов "Калькулятора"
begin
 ShellExecute(Handle,'open','Calc',nil,nil,SW_RESTORE);
// ShellExecute(Handle,'open','CGraph',nil,nil,SW_RESTORE);
end;

procedure TForm1.RGMetodClick(Sender: TObject);
begin
 if (RGMetod.ItemIndex = 1)
  then EDF.Enabled := false
  else EDF.Enabled := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Memo1.Modified := true;
 Func := F;
end;

procedure TForm1.AExitExecute(Sender: TObject);
begin
 Close;
end;

procedure TForm1.ApplicationEvents1Hint(Sender: TObject);
begin
 StatusBar1.Panels[2].Text := Application.Hint;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
// Отображение позиции курсора в панели состояния
begin
 StatusBar1.Panels.Items[1].Text:= IntToStr(Memo1.SelStart+1);
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// Отображение позиции курсора в панели состояния
begin
 StatusBar1.Panels.Items[1].Text:= IntToStr(Memo1.SelStart+1);
end;

procedure TForm1.AHelpExecute(Sender: TObject);
begin
 Application.HelpCommand(HELP_FINDER,0);
end;

end.
