IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> касательная к графику., запарился уже. график строит касательную не хочет...
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


надо построить график и касательную к функции вида A*x^3+Bx^2+C*x+D, где A,B,C и В задаются пользователем, а конкретно в TEdit'ы. причем точка касания задается произвольно по щелчку на графике. график норм строится а касательную как-то через одно место.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, TeeFunci, Series, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
Button1: TButton;
Label6: TLabel;

procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

type
Tpoint= record
x,y:smallint;
end;
var
Form1: TForm1;
a,b,c,d:integer;
o:Tpoint;

const
x0=600;
y0=200;
implementation

{$R *.dfm}

Function PaintXY(Const t: integer): real;
var x: real;
Begin
x:=t/30-10;
PaintXY :=-(A*x*x*x+B*x*x+C*x+D);
End;




procedure TForm1.Button1Click(Sender: TObject);
var i,x:integer;
begin
with Image1.Canvas do FillRect(Rect(0,0,Width,Height));
a:=strtoint(edit1.Text);
b:=strtoint(edit2.Text);
c:=strtoint(edit3.Text);
d:=strtoint(edit4.Text);

image1.Canvas.MoveTo(0,round(PaintXY(0)));
i:=0;
while i<604 do
begin
Form1.image1.Canvas.Pen.Width:=3;
Form1.image1.Canvas.Pen.Color:=clBlack;
Form1.image1.Canvas.LineTo(i,round(PaintXY(i)*10+o.y));
i:=i+5;
end;
end;



Procedure Kasat(Const l : integer);
Var
q,s : real;
i:integer ;
Begin
form1.Image1.Canvas.Pen.Color:=clred;
i:= 0;
s:=l/30-10;
Q := 3*A*s*s+2*B*s+C;
While i < 604 Do
Begin

form1.Image1.Canvas.LineTo(round(i),(round(PaintXY(i))*10-200)+q*((i/30-10)-s))));
i:= i +5;
End;

End;



procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
st : String;
begin

label6.Caption:=inttostr(x);
St := 'X= ' + IntToStr(X) + '; ' + 'Y= '+ IntToStr(Y) + ' Построить касательную в этой точке?';
if (Image1.Canvas.Pixels[x,y] = clBlack) and (MessageDLG(St,mtinformation,[mbNo,mbok],0) = mrOk)
Then
Begin
Kasat(Round(X));
End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
o.x:=round (form1.Width/2);
o.y:=round(form1.Height/2);
end;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


вроде вот так работает.
но однозначно будут проблемы при сворачивании окна или перекрывании его.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, TeeProcs, TeEngine, Chart, TeeFunci, Series, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Edit2: TEdit;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
Button1: TButton;
Label6: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
a,b,c,d:integer;
o: TPoint;

implementation

{$R *.dfm}
//наша функция
function f(const x,a,b,c,d: integer): integer;
begin
f:=a*x*x*x+b*x*x+c*x+d;
end;
//производная
function df(const x,a,b,c,d: integer): integer;
begin
df:=3*a*x*x+2*b*x+c;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
o.X:=Form1.Image1.Width div 2;
o.Y:=Form1.Image1.Height div 2;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i,bord: integer;
begin
//стираем старый график
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
//параметры для функции
a:=StrToInt(Edit1.Text);
b:=StrToInt(Edit2.Text);
c:=StrToInt(Edit3.Text);
d:=StrToInt(Edit4.Text);
//определяем пределы изменения аргумента
bord:=Form1.Image1.Width div 5;
Form1.Image1.Canvas.MoveTo(o.X-bord,o.Y+5*f(-bord div 5,a,b,c,d));
Image1.Canvas.Pen.Color:=clBlack;
Image1.Canvas.Pen.Width:=3;
//строим график функции
for i:=-bord to bord do
Form1.Image1.Canvas.LineTo(o.X+i*5,o.Y+5*f(i,a,b,c,d));
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var st: string;
bord,i: integer;
begin
St := 'X= ' + IntToStr(X-o.X) + '; ' + 'Y= '+
IntToStr(Y-o.Y) +
' Построить касательную в этой точке?';
if (Image1.Canvas.Pixels[x,y] = clBlack) and
(MessageDLG(St,mtinformation,[mbNo,mbok],0) = mrOk) then
begin
Image1.Canvas.Pen.Color:=clRed;
Image1.Canvas.Pen.Width:=1;
bord:=Form1.Image1.Width div 5;
Form1.Image1.Canvas.MoveTo(o.X-bord*5,o.Y+5*f(-bord,a,b,c,d)+5*df(-bord,a,b,c,d)*(-bord-X+o.X));
//строим график функции
for i:=-bord to bord do
//вот здесь у меня в формуле была ошибка
Form1.Image1.Canvas.LineTo(o.X+i*5,o.Y+5*f(((X-o.X) div 5),a,b,c,d)+5*df(((X-o.X) div 5),a,b,c,d)*(i-(X-o.X) div 5));
end;
end;

end.


Сообщение отредактировано: мисс_граффити -


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


спасибо. пока попробовать не могу делфи под рукой нет, так что в чем была ошибка?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


Если честно, не знаю.
Я написала заново...

Тот вариант, кстати, даже не откомпилировался.


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Юля, она точно строит касательную? Смотри, что у меня вышло:
Прикрепленное изображение

Кстати, никаких проблем с перекрытием/сворачиванием не будет, график хранится в Image - все в порядке...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


не откомпилился? видимо промежуточный вариант. я ковырял его всячески....
интересную касательную строит мдамс.. у меня тоже всякие забавные варианты выдавала....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


прошу прощения, я не тот вариант (не последний) выложила.
в формуле ошибка была.
исправила...

кстати, можно f(((X-o.X) div 5),a,b,c,d) и df(((X-o.X) div 5),a,b,c,d) не считать на каждом шаге, а посчитать один раз и запомнить в какие-нибудь переменные.

Цитата
Кстати, никаких проблем с перекрытием/сворачиванием не будет, график хранится в Image - все в порядке...

спасибо...
думала, как с PaintBox'ом

Сообщение отредактировано: мисс_граффити -


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 20:20
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name