График на Timage

[Azaza]

Здравствуйте! При использовании первого графика, рисунок графика правильный(есть разрывы функции).

Код: Выделить всё

procedure TForm1.Button2Click(Sender: TObject);
const
  x3=-1;
  x4=1;
  m=50;
  var
    x0,y0:integer;
    x,y:single;
begin
  Form1.Image1.Canvas.Brush.Color:=clBtnFace;
Form1.Image1.Canvas.FillRect(0,0,Width,Height);
x1:=strtofloat(edit1.text);
x2:=strtofloat(edit2.text);
with image1 do
   begin
    x0:=width div 2;
    y0:=height div 2;
    with canvas do
   begin
   pen.Color:=clblack;
   pen.Width:=1;
   moveto(0,y0);
   lineto(width,y0);
   moveto(x0,0);
   lineto(x0,height);
   pen.Color:=clred;
   pen.Width:=2;
   x:=x1;
   y:=5*cos(x);
   moveto(x0+trunc(x*m),y0-trunc(y*m));
   while (x<x3)and(x<=x2) do
begin
x:=x+0.01;
Y:=5*cos(x);
lineto(x0+trunc(x*m),y0-trunc(y*m));
end;
   Y:=sin(x);
   moveto(x0+trunc(x*m),y0-trunc(y*m));
   while (x<=x4) and (x<=x2) do
begin
x:=x+0.01;
Y:=sin(x);
lineto(x0+trunc(x*m),y0-trunc(y*m));
end;
y:=5*cos(x);
   moveto(x0+trunc(x*m),y0-trunc(y*m));
   while (x<=x2) do
begin
x:=x+0.01;
Y:=5*cos(x);
lineto(x0+trunc(x*m),y0-trunc(y*m));
end;
  end;
end;
end;           

Но при использовании второго кода, разрывов функции нет.

Код: Выделить всё

function tablica1(var x2,x:real):real;
begin

   if (x>=-1.00000000000017) and (x<=1.00000000000017) then

   tablica1:=sin(x)else
     tablica1:=5*cos(x);
end;         

procedure graffik(var x1,x2,x:real);
const
  m=50;
  var
    x0,y0:integer;
    y:real;
begin
  Form4.Image1.Canvas.Brush.Color:=clBtnFace;
Form4.Image1.Canvas.FillRect(0,0,form4.image1.Width,form4.Image1.Height);
x1:=strtofloat(form4.edit1.text);
x2:=strtofloat(form4.edit2.text);
with form4 do begin
with image1 do
   begin
    x0:=width div 2;
    y0:=height div 2;
    with canvas do
   begin
   pen.Color:=clblack;
   pen.Width:=1;
   moveto(0,y0);
   lineto(width,y0);
   moveto(x0,0);
   lineto(x0,height);
   pen.Color:=clred;
   pen.Width:=2;

   x:=x1;
   y:=tablica1(x2,x);
    MoveTo(x0+trunc(x*m),y0-trunc(y*m));
   while (x<=x2) do begin
    y:=tablica1(x2,x);
     x:=x+0.01;
     if ((x>=-1.00000000000018) and (x<=-1.00000000000016))or
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m)) else lineto(x0+round(x*m),y0-round(y*m));
    end;
   end;
   end;
    end;
    end;     

Подскажите пожалуйста, где ошибка во втором коде.

[Дож]

Возможно, что дело в фрагменте

Код: Выделить всё

     if ((x>=-1.00000000000018) and (x<=-1.00000000000016))or
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m))


который пропускает ровно эти места.

[Azaza]

Возможно, что дело в фрагменте

Код: Выделить всё

     if ((x>=-1.00000000000018) and (x<=-1.00000000000016))or
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m))


который пропускает ровно эти места.

Как же сделать, чтобы он не пропускал ровно эти места?

[Дож]

Может быть, выпилить этот фрагмент?

[vitaly_l]

Код: Выделить всё

with form4 do
with image1 do
with canvas do


Все они имеют width и height - лучше не использовать with в таких случаях, т.к. результат может быть неправильным.

Код: Выделить всё

     if ((x>=-1.00000000000018) and (x<=-1.00000000000016)) xor
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m)) else lineto(x0+round(x*m),y0-round(y*m));


Там xor вместо or. Так будет нужный результат?

.

[Azaza]

Код: Выделить всё

     if ((x>=-1.00000000000018) and (x<=-1.00000000000016)) xor
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m)) else lineto(x0+round(x*m),y0-round(y*m));


Там xor вместо or. Так будет нужный результат?

.

Ничего не изменилось, результат прежний.

[Дож]

Конечно, ничего не должно было поменяться: одновременно оба операнда xor не могут стать True, потому что там условие на непересекающиеся отрезки.

[vitaly_l]

Ничего не изменилось, результат прежний.

Ну тогда x:=x+0.01; замените на x:=x+0.00000000000001; Так будет выводить нужный результат?
Или поменяйте местами, присвоение x и y;

Добавлено спустя 1 минуту 11 секунд:

Код: Выделить всё

y:=tablica1(x2,x);
x:=x+0.01;


замените на

Код: Выделить всё

y:=y+0.01;
x:=tablica1(y2,y);


[Azaza]

Возможно, что дело в фрагменте

Код: Выделить всё

     if ((x>=-1.00000000000018) and (x<=-1.00000000000016))or
        ((x<=1.00000000000018) and (x>=1.00000000000016))
     then moveto(x0+trunc(x*m),y0-trunc(y*m))


который пропускает ровно эти места.

Ничего не изменилось, результат прежний.

Или поменяйте местами, присвоение x и y;

Добавлено спустя 1 минуту 11 секунд:

Код: Выделить всё

y:=tablica1(x2,x);
x:=x+0.01;


замените на

Код: Выделить всё

y:=y+0.01;
x:=tablica1(y2,y);


Я не правильно прочитал ваше сообщение и заменил y:=tablica1(x2,x); x:=x+0.01; на x:=x+0.01; y:=tablica1(x2,x);,
это помогло.
Большое всем спасибо, теперь график правильный.
код программы:

Код: Выделить всё

function tablica1(var x2,x:real):real;
begin

   if (x>=-1.00000000000017) and (x<=1.00000000000017) then

   tablica1:=sin(x)else
     tablica1:=5*cos(x);
end;         

procedure graffik(var x1,x2,x:real);
const
  m=50;
  var
    x0,y0:integer;
    y:real;
begin
  Form4.Image1.Canvas.Brush.Color:=clBtnFace;
Form4.Image1.Canvas.FillRect(0,0,form4.image1.Width,form4.Image1.Height);
if (Length(form4.edit1.text)<>0)
  and (Length(form4.edit2.text)<>0)
  and (Length(form4.edit3.text)<>0) then begin
x1:=strtofloat(form4.edit1.text);
x2:=strtofloat(form4.edit2.text);
with form4 do begin
with image1 do
   begin
    x0:=width div 2;
    y0:=height div 2;
    with canvas do
   begin
   pen.Color:=clblack;
   pen.Width:=1;
   moveto(0,y0);
   lineto(width,y0);
   moveto(x0,0);
   lineto(x0,height);
   pen.Color:=clred;
   pen.Width:=2;
   y:=tablica1(x2,x);
   x:=x1;
    MoveTo(x0+trunc(x*m),y0-trunc(y*m));
   while (x<=x2) do begin
     x:=x+0.01;
     y:=tablica1(x2,x);
     if ((x>=-1.00000000000018) and (x<=-1.00000000000016))or
        ((x<=1.00999999999984) and (x>=1.00999999999982))
     then moveto(x0+trunc(x*m),y0-trunc(y*m)) else lineto(x0+round(x*m),y0-round(y*m));
    end;
   end;
   end;
    end;
  end
   else messagedlg('Нужно заполнить все поля',mtinformation,[mbok],0);
    end;