Курсовой проект Задача о трёх телах / 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.