unit Root1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    LNote: TLabel;
    Label10: TLabel;
    LIter: TLabel;
    EX: TEdit;
    EF: TEdit;
    Memo1: TMemo;
    Panel1: TPanel;
    LXmin: TLabel;
    LXmax: TLabel;
    Label5: TLabel;
    LX0: TLabel;
    EXmin: TEdit;
    EXmax: TEdit;
    EDF: TEdit;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    EDAbsX: TEdit;
    EDRelX: TEdit;
    EX0: TEdit;
    RGMetod: TRadioGroup;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton7: TToolButton;
    ToolButton6: TToolButton;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    MFile: TMenuItem;
    MOpen: TMenuItem;
    MSave: TMenuItem;
    N1: TMenuItem;
    MExit: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N3: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    ImageList1: TImageList;
    ActionList1: TActionList;
    AOpen: TAction;
    ASave: TAction;
    AExit: TAction;
    ARoot: TAction;
    ACalc: TAction;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RGMetodClick(Sender: TObject);
    procedure ARootExecute(Sender: TObject);
    procedure AOpenExecute(Sender: TObject);
    procedure ASaveExecute(Sender: TObject);
    procedure ACalcExecute(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 EXminKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure AExitExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
function F(X: real): real;

implementation

uses Equ1, Synt, UErrors, ShellAPI;

{$R *.DFM}

var NIter:longint;   // Счетчик числа обращений к функции
    FFile: TextFile; // Файловая переменная протокола
const Line = #13'********************************************************'#13;

function F(X: real): real;
// Функция вычисления левой части уравнения
var Y: real;
begin
 if (not SetData('X',X))
  then begin
   Application.MessageBox(
        'В описании уравнения отсутствует аргумент X',
        'Ошибка',MB_OK+MB_ICONSTOP);
   abort;
  end;
 if(not Calculate(Y))
  then begin
   Application.MessageBox(
        'Ошибка вычисления функции',
        'Ошибка',MB_OK+MB_ICONSTOP);
   abort;
  end;
 Inc(NIter);
 Result := Y;
end;

procedure TForm1.FormCreate(Sender: TObject);
// Операции при создании формы
begin
// Задание указателя на функцию F
 Func := F;
// Создание файла протокола и занесение в него текущей даты
 AssignFile(FFile, 'TEqu_log.txt');
 Rewrite(FFile);
 Write(FFile, Line, 'Протокол работы программы "TEqu1" от ',
              DateTimeToStr(Now),Line);
 Memo1.Modified := true;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
// Операции при закрытии формы
begin
// Закрытие файла протокола
 Write(FFile, #13,Line, 'Работа завершена: ',
              DateTimeToStr(Now),Line);
 CloseFile(FFile);
end;

procedure TForm1.RGMetodClick(Sender: TObject);
// Процедура смены метода
begin
 if(RGMetod.ItemIndex < 2)
  // Если метод дихотомии или хорд
  then begin
   EXmin.Visible := true;
   EXmax.Visible := true;
   LXmin.Visible := true;
   LXmax.Visible := true;
   EX0.Visible := false;
   LX0.Visible := false;
  end
  else begin
   EXmin.Visible := false;
   EXmax.Visible := false;
   LXmin.Visible := false;
   LXmax.Visible := false;
   EX0.Visible := true;
   LX0.Visible := true;
  end;
  // Если метод простых итераций
  EDF.Enabled := not (RGMetod.ItemIndex = 2);
end;

procedure TForm1.ARootExecute(Sender: TObject);
// Трансляция уравнения и расчет корня
var R: real;
    Good: boolean;
begin
 // Стираются результаты прошлых вычислений
 EX.Text := '';
 EF.Text := '';
 LIter.Caption := '';
 LNote.Caption := '';
 // Закрывается форма сообщений об ошибках
 if (FErrors <> nil) then FErrors.Close;
 // Создается польская запись
 if not CreatePZ(Memo1.Text)
  then begin
// При ошибках трансляции показывается форма с сообщениями
   Application.CreateForm(TFErrors, FErrors);
   FErrors.LBErrors.Items.Assign(ErrorList);
   FErrors.Show;
   exit;
  end;
// Чтение и проверка синтаксиса параметров алгоритмов
  try
   if(RGMetod.ItemIndex < 2)
    then begin
      Xmin := StrToFloat(EXmin.Text);
      Xmax := StrToFloat(EXmax.Text);
    end
    else X0 := StrToFloat(EX0.Text);
   DAbsX := Abs(StrToFloat(EDAbsX.Text));
   DRelX := Abs(StrToFloat(EDRelX.Text));
   DF := Abs(StrToFloat(EDF.Text));
  except
   Application.MessageBox(
        'Неверный формат чисел',
        'Исправьте ошибку',MB_OK+MB_ICONSTOP);
   exit;
  end;

// Проверка задания интервала неопределенности
 if(RGMetod.ItemIndex < 2)
  then begin
   if(Xmin = Xmax)
    then begin
     Application.MessageBox(
        'Не задан диапазон аргумента',
        'Задайте информацию',MB_OK+MB_ICONSTOP);
     exit;
    end
  end;

// Обеспечение условия Xmin < Xmax
  if (RGMetod.ItemIndex < 2) and (Xmin > Xmax)
   then begin
    R := Xmin;
    Xmin := Xmax;
    Xmax := R;
   end;

// Проверка задания погрешностей
  if (DAbsX = 0) and (DRelX = 0) and (DF = 0)
   then begin
    Application.MessageBox(
       'Не задана информация о погрешностях',
       'Задайте информацию',MB_OK+MB_ICONSTOP);
    exit;
   end;

// Занесение в протокол текста задачи
   if (Memo1.Modified)
    then begin
     Write(FFile, Line, 'Решаемая задача:'#13);
     Write(FFile, Memo1.Text);
     Memo1.Modified := false;
    end;
// Занесение в протокол параметров решения задачи
   Write(FFile, Line);
   if (RGMetod.ItemIndex < 2)
    then Write(FFile, 'Интервал поиска: ',
               FloatToStrF(XMin,ffGeneral,7,0), ' - ',
               FloatToStrF(XMax,ffGeneral,7,0))
    else Write(FFile, 'Начальная точка: ',
               FloatToStrF(X0,ffGeneral,7,0));
   Write(FFile, #13'Абсолютная погрешность X: ',
                FloatToStrF(DAbsX,ffGeneral,7,0),
                #13'Относительная погрешность X: ',
                FloatToStrF(DRelX,ffGeneral,7,0));
   if (RGMetod.ItemIndex <> 2)
     then Write(FFile, #13'Погрешность невязки: ',
                FloatToStrF(DF,ffGeneral,7,0));
   Write(FFile, #13'Метод: ');

// Расчет
   NIter := 0;
   case RGMetod.ItemIndex of
    0: begin
        Write(FFile, 'дихотомия');
        Good := Dihot;
       end;
    1: begin
        Write(FFile, 'хорд');
        Good := Chord;
       end;
    2: begin
        Write(FFile, 'простых итераций');
        Good := Iterat;
       end;
    3: begin
        Write(FFile, 'модифицированный Ньютона');
        Good := Nevton;
       end;
   end;

   if Good then begin
// Расчет успешно завершен
    EX.Text := FloatToStrF(X,ffGeneral,7,0);
    EF.Text := FloatToStrF(FDelta,ffGeneral,7,0);
    LIter.Caption := IntToStr(NIter);
    LNote.Caption := 'Отсутствуют';
    // Проверка достоверности корня, найденного дихотомией
    if RGMetod.ItemIndex = 0 then
     if(Xmax - X <= DAbsX) or (Xmax - X <= Abs(X * DRelX))
      then LNote.Caption := 'Возможно, корень превышает заданный предел ' + FloatToStr(Xmax)
      else if(X - Xmin <= DAbsX) or (X - Xmin <= Abs(X * DRelX))
       then LNote.Caption := 'Возможно, корень меньше заданного предела ' + FloatToStr(Xmin);
    // Запись результатов в протокол
    Write(FFile, #13#13'Результаты расчета:',
          #13'Корень: ',EX.Text,#13'Невязка: ',EF.Text,
          #13'Итераций: ',LIter.Caption,#13'Замечания: ',LNote.Caption);
   end
   else begin
// Расчет был прерван
     LNote.Caption := 'Расчет прерван';
     Write(FFile, #13#13,LNote.Caption);
     Application.MessageBox(
        'Смените исходные данные или метод',
        'Расчет невозможен',MB_OK+MB_ICONSTOP);
    end;
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
 WinExec('Calc', SW_RESTORE);
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.EXminKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
// Передача фокуса следующему окну
begin
 if (Key = VK_RETURN)
   then FindNextControl(Sender as TWinControl, true, true,
                        false).SetFocus;
end;

procedure TForm1.AExitExecute(Sender: TObject);
// Завершение работы
begin
 Close;
end;

end.
