Курсовой проект Задача о трёх телах / Runge / Unit4

unit Unit4;

interface
  uses classes, graphics, types, controls;
  type
    TMouseButtonEx = (mbLeft, mbRight, mbMiddle, mbNone);
    CRunge = class of TRunge;

    T2Rect = record
      EXa, EXb: double;
      EYa, EYb: double;
    end;

    TRealArr = array of double;
    PResArr = ^TResArr;

    Tfun = function (x: double; y: TRealArr): double;  //Тип-функция переводящая [double] -> double
    TfunReal = function (x: double): double;  //Тип-функция переводящая [double] -> double
    TarrFun = array of TFun;  //Массив функций

    TRes = record  //Одна запись в результате
      x: double; //Абсцисса точки
      arr: TRealArr;  //Массив одрдинат для каждой функции
    end;

    TResArr = array of TRes;  // Массив таких значений - сам резуьтат

    //Класс для метода Рунге-Кутты 4 порядка.
    TRunge = class
    private
      Erange: integer;  //кол-во функций в системе
      Estart: TRealArr; //Начальные значения
      EFirst, ELast: double; //Начальное и конечное значение по оси t
      Eeps: double; //Точность
      Efun: TArrfun; //массив функций
      EArr: TResArr; //Массив значений функции в точках, больше 0.
      EArrNeg: TResArr; //Массив значений функции в точках, меньших 0
      EGetInd: integer; //Внутренняя переменная - для быстрого поиска нужного значения
      procedure SetRange(const Value: integer); virtual;//Установить количество функций в системе
      function GetStart(Index: Integer): double; //Получить начальное значений для функции index
      procedure SetStart(Index: Integer; const Value: double);//Установить начальное значение value для функции index
      function GetRes(X: double; index: integer): double; //Узнать значение функции index в точке x
      function GetResInd(X: double): TRealArr; //Узнать значение всех функций в точке x
      function GetCount: integer;   //Узнать общее количество точек
      function GetLeftInd: integer; //Узнать номер самой левой точки в массива
      function GetRightInd: integer; //Узнать номер самой правой точки
      function Value(const x: real; const y: TRealArr; const h: real): TRealArr; //Вычисление значения в следующей точке методом РК-4
      function Value5(const x: real; const y: TRealArr; const h: real): TRealArr;//Вычисление значения в следующей точке методом РК-5
      procedure SetEps(const Value: double); virtual; //Установить значение точности
      function calc(vlast: double; veps: double): TRes; overload; virtual; //Процедура вычисления значения в точке vlast с точностью veps
    public
      property LeftInd: integer read GetLeftInd;   //Левый индекс
      property RightInd: integer read GetRightInd; // Правый индекс в массиве точек
      function GetInd(v: integer; n: integer): double; //Узнать значение функции v в точке n
      property Count: integer read GetCount; //Доступ к количеству точек в результате
      property Arr[X: double]: TRealArr read GetResInd; default; //Доступ к значениям функции в точке x
      property ArrInd[X: double; index: integer]: double read GetRes; //Доступ к значению конкретной функции index в точке x
      property range: integer read Erange write SetRange; //Доступ к количеству функций
      property Start[Index: integer]: double read GetStart write SetStart; //Доступ к начальным значениям
      property First: double read Efirst write EFirst; //Начальное значение по оси t
      property Last: double read ELast write ELast; //Конечное значение по оси t
      property eps: double read EEps write SetEps; //Точность вычисления
      property Fun: TarrFun read EFun write EFun;//Доступ к массиву функций
      constructor Create; virtual;
      function Calcat(vfirst, vlast, veps: double): boolean;  //Вычислить значение на отрезке с точностью
      procedure ProcessMessages;
      function CheckDelat(n: integer; f: TFunReal): double; //Проверить отклонение полученной функции от реальной.
    end;
    type
        TCanv = record
          ECanv: TCanvas;
          EWidth, EHeight: integer;
        end;
        TMouse = record
    //      mouseflag: boolean;
          mousebk: TPoint;
          mousestep: TPoint;
          mouseRect: TRect;
          mouseBtn: TMouseButtonEx;
        end;


    TGraphicsRunge =  class(TRunge)
      private
        EMouse: TMouse;
        ebmp: TBitMap;
        Erect: T2Rect;
        ECanv: TCanv;
        arr: array of TRealArr;
        EVisible: Array of boolean;
        Escaley, Escalex: double;
        procedure SetRange(const Value: integer); override;
        function GetIndex(X: double): integer;
        function GetSize: TPoint;
        procedure SetRect(const Value: T2Rect);
        procedure SetCanvas(const Value: TPoint);
        procedure SetVisible(Index: Integer; const Value: boolean);
        function GetVisible(index: integer): boolean;
        property EWidth: integer read ECanv.ewidth;
        property EHeight:integer read ECanv.eheight;
        property ExA: double read ERect.ExA;
        property EYA:double read ERect.EYA;
        property ExB: double read ERect.ExB;
        property EYB:double read ERect.EYB;
        procedure SetEps(const Value: double); override;
      public
        procedure Redraw;
        procedure ReCreateArr;
        constructor Create; override;
        constructor Assign(v:CRunge);
        property Canvas: TCanvas read ECanv.ECanv write ECanv.ECanv;// write SetCanvas;
        property Size: TPoint read GetSize write SetCanvas;
        property Rect: T2Rect read Erect write  SetRect;
        property Visible[index: integer]: boolean read GetVisible write SetVisible;
        property Scaley: double read  Escaley;
        property ScaleX: double read  Escalex;

        procedure MouseMove(Shift: TShiftState; X, Y: Integer);
        procedure MouseLeave;
        procedure MouseClick;
        procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     end;


    //Класс для исходной задачи
    TProg1 = class(TRunge)
    public
      constructor Create; override; //В конструкторе описываем те входные данные, которые требуется использовать в конкретной задаче
    end;

    //Два класса для тестовых примеров
    TProg2 = class(TRunge)
    public
      constructor Create; override;
    end;

    TProg3 = class(TRunge)
    public
      constructor Create; override;
    end;

  function SRect(vXa, vYa, vXb, vYb:double): T2rect;
implementation
  uses unit2,  sysutils, math, wintypes;

function SRect(vXa, vYa, vXb, vYb:double): T2rect;
begin
  result.EXa:=vXa;
  result.eyA:=vYa;
  result.EXb:=vXb;
  result.eyb:=vYB;
end;
  function sin(x: double): double;
  begin
    result:=system.Sin(x);
  end;
  function exp1(x: double): double;
  begin
    result:=system.Exp(x)+1;
  end;

{ TRunge }
//Конструктор
function TRunge.Calcat(vfirst, vlast, veps: double): boolean;
var t1,t2: TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
    setlength(EArr, 1);  //Устанавливаем в результирующий список значений функции начальные значения
    EArr[0].x:=First;
    EArr[0].arr:=Estart;
    setlength(EArrNeg, 1);
    EArrNeg[0].x:=First;
    EArrNeg[0].arr:=Estart;
    form2.lblTime.Caption:='Вычисление...';
    t1:=GetTime;
    calc(vlast, 0);
    calc(vfirst, 0);
    result:=(EArr[High(EArr)].x >= vLast) and (EArrNeg[High(EArrNeg)].x <= vfirst);
    t2:=GetTime;
    DecodeTime(t2-t1,Hour, Min, Sec, MSec);
    form2.lblTime.Caption:=inttostr(sec*1000+Msec)+' ms';

end;

function TRunge.CheckDelat(n: integer; f: TFunReal): double;
var i: integer;
begin
  result:=abs(f(Earr[0].x) - Earr[0].arr[n]);
  for i := 1 to high(EArr)-2 do
    result:=max(result,abs(f(Earr[i].x) - Earr[i].arr[n]));
  for i := 1 to high(EArrNeg)-2 do
    result:=max(result,abs(f(EArrNeg[i].x) - EArrNeg[i].arr[n]));
end;

constructor TRunge.Create;
begin
  setlength(EArr, 1);  //Устанавливаем в результирующий список значений функции начальные значения
  EArr[0].x:=First;
  EArr[0].arr:=Estart;
  setlength(EArrNeg, 1);
  EArrNeg[0].x:=First;
  EArrNeg[0].arr:=Estart;
end;


function TRunge.GetCount: integer;
begin
  result:=length(EArr)+length(EArrNeg)-1; //Количество точек равно сумме точек, с абсциссой больше нуля и меньше 0
end;

//Узнать значение функции в точке с номером v функции n
function TRunge.GetInd(v, n: integer): double;
begin
  result:=0;
  if n > range then exit; // Если такой функции нет, то выходим.
  if v < length(EArrNeg) then //Если такая функция есть, то рассматриваем варианты, из какого массива брать результат
    if n = 0 then
      result:=Earrneg[high(EArrNeg)-v].x
    else
      result:=Earrneg[high(EArrNeg)-v].arr[n-1]
  else if v < GetCount then
    if n = 0 then
      result:=Earr[v-length(EArrNeg)].x
    else
      result:=Earr[v-length(EArrNeg)].arr[n-1]
  else
    raise Exception.Create('Неверный индекс массива. Getindex('+inttostr(v)+','+inttostr(n)+')');
end;

function TRunge.GetLeftInd: integer;
begin
  result:=high(EArrNeg);
end;

function TRunge.GetRes(X: double; index: integer): double;
begin
  if index in [0..range-1]  then
    result:=GetResInd(x)[index]
  else
    raise Exception.Create('Неверный индекс массива. GetRes('+floattostr(x)+','+inttostr(index)+')');
 end;

//Результат - набор значений ординат результирующих функций в точке X
function TRunge.GetResInd(X: double): TRealArr;
var left, right, t: integer;
  i: integer;
  Arr: TResArr;
begin
  if x>=EFirst then //Выбираем массив, в котором будем искать нужное значение
    Arr:=EArr
  else
    Arr:=EArrNeg;
  //Массив упорядочен, поэтому будем искать значение бинарным посиком по обсцыссе
  //ПОпробуем на снове EGetInd локализовать нужное нам значение
  if  (EGetInd-5 <= high(Arr)) and (abs(Arr[EGetInd-5].x) < abs(x))  then
    left:=EGetInd-5
  else
    left:=0;
  if  (EGetInd+5 <= high(Arr)) and (abs(Arr[EGetInd+5].x) > abs(x))  then
    right:=EGetInd+5
  else
    right:=high(Arr);

  //left и right - границы отрезка.
  while left < right-1 do begin
    t:= (left+right) div 2;
    if abs(Arr[t].x) < abs(x) then
      left:=t
    else if Arr[t].x = x then begin
      right:=t;
      left:=t;
    end else begin
      right:=t;
    end;
  end;
  //Нашли отрезок наименьшей длины, на котором лежит нужный нам результат
  //Представим что функция линейна на этом отрезке
  setlength(Result, Erange);
  if right <> left then
    for i := 0 to ERange-1 do
      result[i]:=(Arr[right].arr[i]-Arr[left].arr[i])/(right-left)*x+Arr[left].arr[i]
  else
    for i := 0 to ERange-1 do
      result[i]:=Arr[right].arr[i];
  //EGetInd присвоим значение левой границы, чтобы при следующем поиске  было легче искать точку.
  EGetInd:=left;
end;

function TRunge.GetRightInd: integer;
begin
  result:=High(EArr)+length(EArrNeg);
end;

//Вернуть начальное значение функции index
function TRunge.GetStart(Index: Integer): double;
begin
  if (0<=index) and (index <= range-1) then
    result:=Estart[index]
  else
    raise Exception.Create('Неверный индекс массива. GetStart('+inttostr(index)+')');
end;


procedure TRunge.ProcessMessages;
var
  Msg: TMsg;
  lResult: boolean;
begin
  lResult := true;
  while lResult do begin
    lResult := false;
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
      lResult := true;
      if Msg.Message <> 3 then begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end;
  end;
end;

//Усатновить количествой функций
procedure TRunge.SetEps(const Value: double);
begin
  EEps := Value;
end;

procedure TRunge.SetRange(const Value: integer);
begin
  Erange:=Value;
  setlength(Estart, Erange);
  setlength(Efun, Erange);
end;

//Установить начальное значнеие value для функции index
procedure TRunge.SetStart(Index: Integer;   const Value: double);
begin
  if (0<=index) and (index <= range-1) then
    Estart[index] :=value
  else
    raise Exception.Create('Неверный индекс массива. SetStart('+inttostr(index)+','+floattostr(value)+')');
end;



  //Увеличить значнеие каждого элемента массива на eps
  function inc(y: TRealArr; eps: double): TRealArr;
  var i: integer;
  begin
    setlength(result, length(y));
    for i := 0 to High(y) do
      result[i]:=y[i]+eps;
  end;

  //Скопировать массив а в масисв b
procedure assign(const a: TRealArr; out b: TRealArr);
var i: integer;
begin
  setlength(b, length(a));
  for i := 0 to high(b) do
    b[i]:=a[i];
end;

//Вычисленние одного шага методом Р-К 4
function TRunge.Value(const x: real; const y: TRealArr; const h: real): TRealArr;
var i: integer; //счетчики
  k: array of TRealArr;
begin
  setlength(k, 4, Erange);
  SetLength(Result, Erange);
    for i:=0 to Erange - 1 do k[0, i]:=Efun[i](x, y);
    for i:=0 to Erange - 1 do k[1, i]:=Efun[i](x+h/2, inc(y,h*k[0, i]/2));
    for i:=0 to Erange - 1 do k[2, i]:=Efun[i](x+h/2, inc(y,h*k[1, i]/2));
    for i:=0 to Erange - 1 do k[3, i]:=Efun[i](x+h, inc(y,h*k[2, i]));
    for i:=0 to Erange - 1 do result[i]:=y[i]+h*(k[0, i] + 2* k[1, i]+ 2*k[2, i]+ k[3, i])/6;
end;

function TRunge.Value5(const x: real; const y: TRealArr; const h: real): TRealArr;
var i: integer; //счетчики
  k: array of TRealArr;
begin
  setlength(k, 6, Erange);
  SetLength(Result, Erange);
    for i:=0 to Erange - 1 do begin
      k[0, i]:=EFun[i](x, y);
      k[1, i]:=EFun[i](x + 1/4*h,   inc(y, h*k[0,i]/4));
      k[2, i]:=EFun[i](x + 3/8*h,   inc(y, h*(3/32*k[0,i] + 9/32*k[1,i])));
      k[3, i]:=EFun[i](x + 12/13*h, inc(y, h*(1932/2197*k[0,i] -  7200/2197*k[1,i] +  7296/2197*k[2,i])));
      k[4, i]:=EFun[i](x + h,       inc(y, h*(439/216*k[0,i] - 8*k[1,i] +  3680/513*k[2,i] - 845/4104*k[3,i])));
      k[5, i]:=EFun[i](x + h/2,     inc(y, h*(- 8/27*k[0,i] + 2*k[1,i] - 3544/2565*k[2,i] + 1859/4104*k[3,i] - 11/40*k[4,i])));
//      result[i] := y[i] + h*(25/216*k[0,i] + 1408/2565*k[2,i] + 2197/4104*k[3,i] - k[4,i]/5);
      result[i] :=y[i] + h*(16/135*k[0,i] + 6656/12825*k[2,i] + 28561/56430*k[3,i] +2/55*k[4,i]-9/50*k[5,i]);
    end;

end;

  //Проверка,
  function checkeps(const a,b: TRealArr): double;
  var i: integer;
  begin
    if length(a) <> length(b) then
      raise Exception.Create('Неверная длина массива. calc.CheckEps: a-'+inttostr(length(a))+', b-'+inttostr(length(b)));
    result:=abs(a[0]-b[0]);
    for i := 1 to high(a) do
      result:=max(result, abs(a[i] - b[i]));
  end;

    //Выполнение одного шага, со всеми проыверками

function TRunge.calc(vlast, veps: double): TRes;
var
  h, hmin: double;
  Arr: PResArr;
  procedure Step;
  var tmp, tmp1, tmp2: TRes;
    i: integer;
    delta: double;
  begin
    //Текущее значение функции
    //x    x+h/2      x+h = x+h/2+h/2
    tmp.arr:=value(Arr^[High(Arr^)].x,Arr^[High(Arr^)].arr,h);
    tmp.x:=Arr^[High(Arr^)].x+h;
//    tmp1.arr:=value5(Arr^[High(Arr^)].x,Arr^[High(Arr^)].arr,h/2);
//    tmp1.x:=Arr^[High(Arr^)].x+h/2;
//    tmp2.arr:=value5(tmp1.x,tmp1.arr,h/2);
    tmp2.arr:=value5(Arr^[High(Arr^)].x,Arr^[High(Arr^)].arr,h);
    tmp2.x:=tmp.x;
    //Если функция по точности нам подходит
    delta:=checkeps(tmp2.arr,tmp.Arr)*abs(ELast-EFirst)/abs(hmin);
    if delta < Eeps then begin
      hmin:=min(hmin, abs(h));
      //То добавляем её в результрующий массив
      setlength(Arr^, length(Arr^)+1);
      setlength(Arr^[High(Arr^)].Arr, Erange);
      for i := 0 to Erange-1 do
        Arr^[High(Arr^)].Arr[i]:=tmp.arr[i];//+(tmp2.arr[i]-tmp.arr[i])/31;
      Arr^[High(Arr^)].x:=tmp2.x;
      //Если точность хорошая, то увеличиваем длину шага
      if delta < Eeps/1000 then
        h:=2*h;
    end else begin
      //Если точность не достигнута, то уменьшаем шаг
      h:=h/2;
    end;
  end;
begin
  Last:=vlast;
  if veps > 0 then
    Eeps:=veps;
  h:=(Elast-Efirst)/10;
  hmin:=abs(h);
    if Elast > EFirst then begin
    Arr:=@Earr;
    while Arr^[High(Arr^)].x < last  do begin
      step;
    end
  end else begin
    Arr:=@EarrNeg;
    while Arr^[High(Arr^)].x > last  do begin
      step;
    end;
  end;


  result:=Arr^[High(Arr^)];
end;




{ TProg1 }
//x  = y[1]
//x` = y[0]
//y =  y[3]
//y` = y[2]
function fun1_1(x: double; y: TRealArr): double;
const mu = 1/82.45;
      mun = 1-mu;
begin
  result:=2*y[2]+y[1] - mun*(y[1]+mu)/power(sqrt(sqr(y[1]+mu)+sqr(y[3])),3) - mu*(y[1]-mun)/power(sqrt(sqr(y[1]-mun)+sqr(y[3])),3);  //+ c мю
end;

function fun1_2(x: double; y: TRealArr): double;
begin
  result:=y[0];
end;

function fun1_3(x: double; y: TRealArr): double;
const mu = 1/82.45;
      mun = 1-mu;
begin
  result:=-2*y[0]+y[3]-mun*y[3]/power(sqrt(sqr(y[1]+mu)+sqr(y[3])),3)-mu*y[3]/power(sqrt(sqr(y[1]-mun)+sqr(y[3])),3);
end;

function fun1_4(x: double; y: TRealArr): double;
begin
  result:=y[2];
end;


//Основная задача
constructor TProg1.Create;
begin
  range:=4;
  fun[0]:=fun1_1;
  fun[1]:=fun1_2;
  fun[2]:=fun1_3;
  fun[3]:=fun1_4;
  start[0]:=1.2;
  start[1]:=0;
  start[2]:=0;
  start[3]:=-0.4;//..1.0495;
  First:=0;
  inherited;
end;




{ TProg2 }

{ TProg2 }

function fun2_1(x: double; y: TRealArr): double;
begin
  result:=y[1];
  //y[1] = y`[0];
end;

function fun2_2(x: double; y: TRealArr): double;
begin
  result:=y[2];
  //y[2] = y`[1] = y``[0]
end;

function fun2_3(x: double; y: TRealArr): double;
begin
  result:=-y[1];
  //y`[2] = y``[1] = y```[0]
end;


//y = sin(x)
//y[0] = y =        sin(x)
//y[1] = y` = y`[0] = cos(x)
//y[2] = y`` = y`[1] = -sin(x)
//y``` = y``[1] = y`[2] = -cos(x) = -y[1]
//y``` = -y`
//t`` = -t   t(0) = 1   t(1)

constructor TProg2.Create;
begin
  range:=3;
  fun[0]:=fun2_1;
  fun[1]:=fun2_2;
  fun[2]:=fun2_3;
  start[0]:=0;
  start[1]:=1;
  start[2]:=0;
  First:=0;
  inherited;
end;

{ TProg3 }


function fun3_1(x: double; y: TRealArr): double;
begin
  result := y[1];
end;

function fun3_2(x: double; y: TRealArr): double;
begin
  result :=  3*exp(x)+8 + 6*y[1] - 8*y[0];
end;

//y`` - 6y`+8*y = 3*exp(x) + 8;
// y = c1*exp(4x) + c2*exp(2x) + exp(x)+1
//y` = 4*c1*exp(4x) + 2*c2*exp(2x) + exp(x)
//y`` = 16c1 exp(4^x) + 4*c2 * exp(2x) + exp(x);
//y(0) = c1+c2+1+1 = 2
//y`(0) = 4c1+2c2+1 = 1

constructor TProg3.Create;
begin
  range:=2;
  fun[0]:=fun3_1;
  fun[1]:=fun3_2;
  start[0]:=2;
  start[1]:=1;
  First:=0;
  inherited;
end;

{ TGraphicsRunge }

constructor TGraphicsRunge.Assign(v: CRunge);
var i: integer;
  g: TRunge;
begin
  create;
  g:=v.Create;
  range:=g.Erange; //кол-во функций в системе
  for i := 0 to Erange-1 do
    Estart[i]:=g.EStart[i];
  EFirst:=g.EFirst;
  ELast:=g.ELast; //Начальное и конечное значение по оси t
  for i := 0 to Erange-1 do
    Efun[i]:=g.Efun[i];//массив функций
  g.Free;
end;

constructor TGraphicsRunge.Create;
begin
  //inherited;
 // EMouse.mouseflag:=false;
  EMouse.mouseBtn:=mbNone;
  Erect.EXa:=Efirst-1;
  Erect.EXb:=EFirst+1;
  Erect.EYa:=1;
  Erect.EYb:=-1;
  EEps:=0.01;
//  calc(Exa, 0.1);
//  calc(Exb, 0.1);
  ebmp:=graphics.TBitmap.Create;
end;

function TGraphicsRunge.GetIndex(X: double): integer;
var left, right, t: integer;
  Arr: TResArr;
begin
  if x>=EFirst then //Выбираем массив, в котором будем искать нужное значение
    Arr:=EArr
  else
    Arr:=EArrNeg;
  //Массив упорядочен, поэтому будем искать значение бинарным посиком по абсцыссе
  left:=0;
  right:=high(Arr);
  //left и right - границы отрезка.
  while left < right-1 do begin
    t:= (left+right) div 2;
    if abs(Arr[t].x) < abs(x) then
      left:=t
    else if Arr[t].x = x then begin
      right:=t;
      left:=t;
    end else begin
      right:=t;
    end;
  end;
  result:=left;
end;

function TGraphicsRunge.GetSize: TPoint;
begin
  result:=Point(ECanv.EWidth, ECanv.EWidth);
end;

function TGraphicsRunge.GetVisible(index: integer): boolean;
begin
  if index < length(EVisible) then
    result:=EVisible[index]
  else
    result:=false;
end;

procedure TGraphicsRunge.MouseClick;
begin

end;

procedure TGraphicsRunge.MouseDown( Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 // EMouse.mouseflag:=true;
  EMouse.mousebk:=Point(X,y);
  EMouse.mousestep:=Point(X,y);
  EMouse.mouseBtn:=TMouseButtonEx(Button);
end;

procedure TGraphicsRunge.MouseLeave;
begin
          ECanv.ECanv.Draw(0,0, ebmp);
end;

procedure TGraphicsRunge.MouseMove(Shift: TShiftState; X, Y: Integer);
var i: integer;
Vx, VY: double;
Text: string;
begin
  with Emouse do begin
    case mouseBtn of
      mbLeft:
        begin
          Rect:=SRect(Rect.EXa+(-X+mousestep.X)*scalex,Rect.EYa+(Y-mousestep.Y)*scaleY,Rect.EXB+(-X+mousestep.X)*scalex,Rect.EYB+(Y-mousestep.Y)*scaleY);
          mousestep:=Point(x, Y);
        end;
      mbRight:
        begin
          mousestep:=Point(x, Y);
          ECanv.ECanv.Draw(0,0, ebmp);
          ECanv.ECanv.Brush.Style:=bsClear;
          ECanv.ECanv.Pen.Color:=clGray;
          ECanv.ECanv.Pen.Style:=psDash;
          if EMouse.mouseBtn = mbRight then
            ECanv.ECanv.Rectangle(EMouse.mousebk.X,EMouse.mousebk.y,EMouse.mousestep.x, EMouse.mousestep.y);
          ECanv.ECanv.Pen.Style:=psSolid;
        end;
      else
        begin
          VX:= X*scalex;
          VY:= Y*scaley;
          Canvas.Draw(0,0,ebmp);
          canvas.Pen.Color:=clBlack;
          for i := 0 to Range-1 do
            if abs((EYb-arr[i, X])/scaley - y) < 7 then begin
              case i of
               0:    canvas.Pen.Color:=clRed;
               1:    canvas.Pen.Color:=clGreen;
               2:    canvas.Pen.Color:=clBlue;
               3:    canvas.Pen.Color:=clPurple;
              end;
              canvas.Brush.Color:=canvas.Pen.Color;
              Canvas.Ellipse(x-3,y-3, x+3, y+4);
              break;
            end;
          canvas.moveto(0,y);
          canvas.lineto(EWidth,y);
          canvas.moveto(x,0);
          canvas.lineto(x,EHeight);
          canvas.Brush.Color:=ColorToRGB(clCream) ;
          text:= floattostrf(Vx+ExA, ffGeneral,round(-log10(eps))+1,round(-log10(eps))+1) + ' ' + floattostrf(eyb-VY, ffGeneral,round(-log10(eps))+1,round(-log10(eps))+1);
          canvas.Rectangle(x,y,x+canvas.TextWidth(Text)+5, y-canvas.TextHeight(Text)-3);
          Canvas.TextOut(X+2,Y-canvas.TextHeight(Text)-2, text);
        end;

    end;
  end;


end;

procedure TGraphicsRunge.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if EMouse.mouseBtn = mbRight then begin
    if (abs(EMouse.mousebk.X-EMouse.mousestep.x ) < 10) and (abs(EMouse.mousebk.y-EMouse.mousestep.y ) < 10) then begin
      Rect:=SRect((3*ExA - exb)/2,(3*EYA - eYB)/2,(3*ExB - exA)/2,(3*EYB - eYA)/2);
    end else begin
      Rect:=SRect(EMouse.mousebk.X*scalex+exa,eYb-EMouse.mousebk.y*scaley,EMouse.mousestep.x*scalex+exa,eYB- EMouse.mousestep.y*scaley);
    end;

  end;


  EMouse.mouseBtn:=mbNone;

end;


procedure TGraphicsRunge.ReCreateArr;
var
  i: integer;
  index: integer;
  j: integer;
  x: double;
begin
//  Определим масштаб
  try
  if exa >= Efirst then begin
    index:=GetIndex(exa); // из EArr
    for i := 0 to EWidth do begin // I - точка на рисунке
      X:=exa +  (exb-exa) / Ewidth * i; //Cоответствующая её точка x
      for j := index to high(EArr) do
        if EArr[j].x > X  then break;
      //Возбмем значение в точке j-1
      index:=j-1;
      for j := 0 to erange-1 do
        arr[j,i]:=EArr[index].arr[j]+ (EArr[index-1].arr[j]-EArr[index].arr[j])/(EArr[index-1].x-EArr[index].x) * (X - EArr[index].x);
    end;
  end else begin
    index:=GetIndex(exa); // из EArrNeg
    setlength(arr, Erange, EWidth+1);
    for i := 0 to EWidth do begin // I - точка на рисунке
      X:=exa +  (exb-exa) / Ewidth * i; //Cоответствующая её точка x
      for j := index downto 0 do
        if EArrNeg[j].x > X  then break;
      //Возбмем значение в точке j-1
      if j = -1 then
        break;
      index:=j+1;
      for j := 0 to erange-1 do
        arr[j,i]:=EArrNeg[index-1].arr[j]+ (-EArrNeg[index-1].arr[j]+EArrNeg[index].arr[j])/(EArrNeg[index-1].x-EArrNeg[index].x) * (EArrNeg[index-1].x-X);
    end;
    index:=0;
    for i := i to EWidth do begin // I - точка на рисунке
      X:=exa +  (exb-exa) / Ewidth * i; //Cоответствующая её точка x
      for j := index to high(EArr) do
        if EArr[j].x > X  then break;
      //Возбмем значение в точке j-1
      index:=j-1;
      if index+1 > high(EArr) then break;
      for j := 0 to erange-1 do
        arr[j,i]:=EArr[index].arr[j]+ (EArr[index+1].arr[j]-EArr[index].arr[j])/(EArr[index+1].x-EArr[index].x) * (X - EArr[index].x);
    end;
  end;
  except

  end;
end;

procedure TGraphicsRunge.Redraw;
var canv: Tcanvas;
  i, i0: integer;
  scalex: double;
  j, h, o: integer;
  k: double;
  txt:string;
begin
  try
  scalex:=escalex;
  canv:=ebmp.Canvas;
  canv.Pen.Color:=clBlack;
  canv.Pen.Width:=1;
  canv.Rectangle(0,0,Ewidth, EHeight);
//--------------------
    if sign(EXb)-sign(EXa) >= 1 then begin
      j:=round(-EWidth * eXa/(eXb-eXa)); //Cоответствующая её точка x
      canv.moveTo(j, 0);
      canv.lineTo(j, EWidth);
      for i := 1 to 4 do begin
        i0:=i*EHeight div 5;
        canv.Ellipse(j-5, i0-5, j+5, i0+5);
        canv.TextOut(j-35,i0+5, FloatToStrF(eYa+(eYb-eYa)*(5-i)/5, ffGeneral, 4, 4));
      end;
    end;
    if sign(Eyb)-sign(EYa) >= 1 then begin
      j:=round(EHeight * eYa/(eYb-eYa)+EHeight); //Cоответствующая её точка x
      canv.moveTo(0, j);
      canv.lineTo(EWidth,j);
      for i := 1 to 4 do begin
        i0:=i*EWidth div 5;
        canv.Ellipse(i0-5, j-5, i0+5, j+5);
        canv.TextOut(i0-5,j+5, floattostrF(exa+(exb-exa)*i/5, ffGeneral, 4, 4));
      end;
    end;
    k:=EHeight/(EYb-EYa);
    for j := 0 to range-1 do begin
      if not EVisible[j] then Continue;
      case j of
       0:    canv.Pen.Color:=clRed;
       1:    canv.Pen.Color:=clGreen;
       2:    canv.Pen.Color:=clBlue;
       3:    canv.Pen.Color:=clPurple;
      end;
      canv.Pen.Width:=2;
      canv.moveTo(0, round((eYb-arr[j, 0])*k));
      for i := 0 to EWidth do begin
        canv.lineTo(i, round((eyb - arr[j, i])*k));
      end;
    end;
    canv.Pen.Color:=clBlack;
    canv.Pen.Width:=1;
    j:=15;
    h:=(ewidth) div j;
    o:=(ewidth) mod j div 2;
    canv.Font.Height:=8;
    for i := 2 to  j-2  do begin
      canv.moveto(o+i*h, 2);
      canv.lineto(o+i*h, 8);
      txt:=floattostrf((o+i*h)*scalex+ExA, ffGeneral,round(-log10(eps)),round(-log10(eps)));
      canv.TextOut(o+i*h-canv.TextWidth(txt) div 2, 10, txt);
      canv.moveto(o+i*h, EHeight-2);
      canv.lineto(o+i*h, EHeight-8);
      canv.TextOut(o+i*h -canv.TextWidth(txt) div 2, EHeight-8-canv.TextHeight(txt), txt);
    end;
    j:=15;
    h:=(EHeight) div j;
    o:=(EHeight) mod j div 2;
    canv.Font.Height:=8;
    for i := 2 to  j-2  do begin
      canv.moveto(2,o+i*h);
      canv.lineto(8,o+i*h);
      txt:=floattostrf(-(o+i*h)*scaley+EYB, ffGeneral,round(-log10(eps)),round(-log10(eps)));
      canv.TextOut(11,o+i*h-4, txt);
      canv.moveto(EWidth-3,o+i*h);
      canv.lineto(EWidth-9,o+i*h);
      canv.TextOut(EWidth-10-canv.TextWidth(txt),o+i*h-4, txt);
    end;
    ECanv.ECanv.Draw(0,0, ebmp);

  except
  end;
end;



procedure TGraphicsRunge.SetCanvas(const Value: TPoint);
begin
  if EHeight <> 0 then
    EscaleY:=(eYB-eYA)/EHeight;
  if Ewidth <> 0 then
    Escalex:=(exB-exA)/Ewidth;
  ECanv.EWidth:=Value.X;
  setlength(arr, Erange, EWidth+1);
  ECanv.EHeight:=Value.y;
  ebmp.Width:=Value.X;
  ebmp.Height:=Value.y;
end;

procedure TGraphicsRunge.SetEps(const Value: double);
begin
  if Value > 0 then begin
    EEps:=value;
    calcat(Exa, Exb, 0);
  end;
end;

procedure TGraphicsRunge.SetRange(const Value: integer);
var i: integer;
begin
  inherited;
  setlength(arr, Erange, EWidth+1);
  setlength(EVisible, Erange);
  for i :=  0 to ERange-1 do
    EVisible[i]:=true;
end;

procedure TGraphicsRunge.SetRect(const Value: T2Rect);
var p: T2Rect;
begin
  p:=Value;
  if p.Exa > p.Exb then begin
    p.Exa:=value.EXb;
    p.EXb:=value.EXa;
  end;
  if p.EYa > p.EYb then begin
    p.EYa:=value.EYb;
    p.EYb:=value.EYa;
  end;
  if EHeight <> 0 then
    EscaleY:=(p.EYb-p.EYa)/EHeight;
  if Ewidth <> 0 then
    Escalex:=(p.EXB-p.EXa)/Ewidth;
 // if (p.EXa < EXa) or (p.EXb > EXb)  then begin
    if calcat(p.EXa, p.EXb, 0) then begin
      Erect:=p;
     ReCreateArr;
     redraw;
//    end else
//       Erect:=p;
//  end else begin
//      Erect:=p;
//     ReCreateArr;
//     redraw;
  end;

end;

procedure TGraphicsRunge.SetVisible( Index: Integer;  const Value: boolean);
begin
  if Index <= high(EVisible) then begin
    EVisible[Index]:=value;
    Redraw;
  end;
end;

{ TRes }

//procedure TRes.Copy(v: TRes);
//var i: integer;
//begin
//  x:=v.x;
//  assign(arr,v.arr));
//end;

end.