Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.06.2012, 22:50   #1
TonyF
Пользователь
 
Аватар для TonyF
 
Регистрация: 16.12.2011
Сообщений: 14
По умолчанию Просьба помочь сделать из 3 процедур одну универсальную

Заранее спасибо всем, кто ответит на мою просьбу!
В общем, само задание:


Разработать приложение для вычисления определенного интеграла, где пределами интегрирования являются два наименьших значения корня системы уравнений:
Решение системы найти по формулам Крамера.
Вычисление производить для интегралов следующего вида (три интеграла под названиями ff1, ff2, ff3)

Построить графики подынтегральной функции в новом диалоговом окне (g1)

Задание выполнено, но не совсем корректно

В чем нужна помощь:
Не получается сделать из трех процедур с интегралами одну универсальную
Не получается сделать поле текстовое, которое будет писать верхний предел интегрирования функций (нижний написан как "Е")

Код:
Function F1(x:real):real;
begin
   f1:=((1)/(sin(x)*sqr(sin(x))*cos(x)*sqr(cos(x))));
end;

Function F2(x:real):real;
begin
   f2:=ln(x)/(exp((1/5)*ln(x)));
end;

Function F3(x:real):real;
begin
   f3:=(exp(3*x)+exp(x))/(exp(2*x)-2*(exp(x))+3);
end;

procedure FF1(Pv,Pn:real; var r:real);
var h,x,rez:real; i:integer;
const NN=20;
begin
    If E=0 then begin
    showmessage('eioaa?ae ia ?aoaai aac aaiaa A>0'); exit; end;
    h:=(Pv-Pn)/NN;  x:=Pn; rez:=0;
    For i:=1 to NN-2 do begin
      x:=x+h;
      rez:=rez+F1(x);
    end;
    R:=h*((f1(Pn+E)+F1(Pv-E))/2+rez);
end;

procedure FF2(Pv,Pn:real; var r:real);
var h,x,rez:real; i:integer;
const NN=20;
begin
    If E=0 then begin
    showmessage('eioaa?ae ia ?aoaai aac aaiaa A>0'); exit; end;
    h:=(Pv-Pn)/NN;  x:=Pn; rez:=0;
    For i:=1 to NN-1 do begin
      x:=x+h;
      rez:=rez+F2(x);
    end;
    R:=h*((f2(Pn+E)+F2(Pv))/2+rez);
end;

procedure FF3(Pv,Pn:real; var r:real);
var h,x,rez:real; i:integer;
const NN=20;
begin
    h:=(Pv-Pn)/NN;  x:=Pn; rez:=0;
    For i:=1 to NN-2 do begin
      x:=x+h;
      rez:=rez+F3(x);
    end;
    R:=h*((f3(Pn)+F3(Pv))/2+rez);
end;

procedure Tform3.Metod(Pn,Pv:real; var r:real);
var i:integer;
begin
    if RadioButton1.Checked=True then FF1(Pv,Pn,r)
    else if RadioButton2.Checked=True then FF2(Pv,Pn,r)
         else if RadioButton3.Checked=True then FF3(Pv,Pn,r)
         else begin showmessage('auae?aoa eioaa?ae');
                         exit;
                   end;
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
    //?aoaiea eioaa?aea
    E:=strtofloat(edit3.Text);
    Chart1.Series[0].Clear;
    MinKorni(stringgrid3,Pn1,Pv1);
    Metod(Pn1,Pv1,rr);
    edit2.Text:=floattostr(rr);
end;

procedure G1(Pv,Pn:real; Tc:TChart);
var x,h:real;
const NN=20;
begin
     if k=3 then E:=0;
     h:=(Pv-Pn)/NN;
     x:=Pn+E;
     while x<=Pv-E do begin
     if k=1 then
     Tc.SeriesList[0].AddXY(x,F1(x),' ',clred)
     else if k=2 then
     Tc.SeriesList[0].AddXY(x,F2(x),' ',clred)
     else if k=3 then
     Tc.SeriesList[0].AddXY(x,F3(x),' ',clred);
     x:=x+h;
     end;
end;

procedure TForm3.Button3Click(Sender: TObject);
begin
     K:=0;
     if RadioButton1.Checked=True then k:=1
     else if RadioButton2.Checked=True then k:=2
         else if RadioButton3.Checked=True then k:=3;
         G1(Pv1,Pn1,Chart1);
end;


procedure TForm3.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    case Key of
    '0'..'9',#8: ;
    else Key:=Chr(0);
    end;
end;

end.
Прогу прикрепляю
Буду благодарен за вашу помощь!

Хоть бы что можно было с этим сделать.... я всю голову уже сломал %)
Вложения
Тип файла: rar kur_finish2.rar (344.3 Кб, 9 просмотров)

Последний раз редактировалось TonyF; 06.06.2012 в 23:54. Причина: Сделать это вообще реально?!
TonyF вне форума Ответить с цитированием
Старый 07.06.2012, 11:14   #2
GetMax
Форумчанин
 
Регистрация: 21.10.2010
Сообщений: 588
По умолчанию

Цитата:
Не получается сделать из трех процедур с интегралами одну универсальную
Чтобы не писать несколько процедур вычисления интеграла, надо передать функцию в качестве параметра одной общей процедуре вычисления. Сначала объявим функцию
Код:
Type
  f_ = function(x:Real):Real;
Потом решаем интеграл
Код:
 //inumber - номер решаемого интеграла
 //f - передаваемая функция
Procedure FF(f:f_;Pv,Pn:Real;inumber:Byte;var r:real);
Const
  NN = 20;
var
 h,x,rez:real; i:integer;
Begin
  if (inumber = 1) or (inumber = 2) then
  Begin
    If E=0 then
    begin
      showmessage('интеграл не решаем без ввода Е>0'); exit;
    end;
  End;
   h:=(Pv-Pn)/NN;  x:=Pn; rez:=0;
   if inumber = 2 then
   Begin
     For i:=1 to NN-1 do
     begin
       x:=x+h;
       rez:=rez+F2(x);
     end;
   End
   else
   Begin
     For i:=1 to NN-2 do
     begin
       x:=x+h;
       rez:=rez+f(x);
     end;
   End;
   if inumber = 1 then  R:=h*((f(Pn+E)+F(Pv-E))/2+rez)
   else
   if inumber = 2 then  R:=h*((f(Pn+E)+F(Pv))/2+rez)
   else
   R:=h*((f(Pn)+F(Pv))/2+rez);
End;
Вызываем процедуру
Код:
procedure Tform3.Metod(Pn,Pv:real; var r:real);
begin
    if RadioButton1.Checked=True then FF(F1,Pv,Pn,1,r)
    else if RadioButton2.Checked=True then FF(F2,Pv,Pn,2,r)
         else if RadioButton3.Checked=True then FF(F3,Pv,Pn,3,r)
         else begin showmessage('выбирете интеграл');
                         exit;
                   end;
Пользователь не знает, чего он хочет, пока не увидит то, что он получил.
Для благодарностей WMR R145235935681
GetMax вне форума Ответить с цитированием
Старый 08.06.2012, 09:42   #3
TonyF
Пользователь
 
Аватар для TonyF
 
Регистрация: 16.12.2011
Сообщений: 14
По умолчанию

Большое спасибо!!!!!!!!!!!!!!!!!!!!!!!!!!!
Сейчас исправлю, еще раз благодарю!
TonyF вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Си(не с++)просьба помочь с задачкой МихаилК Общие вопросы C/C++ 1 10.04.2012 20:49
Просьба помочь с задачкой:) ssnnqq Паскаль, Turbo Pascal, PascalABC.NET 2 31.03.2012 21:29
Просьба помочь! С++/С# Lihoj Фриланс 0 08.12.2011 02:49
Просьба помочь Ditmar Microsoft Office Word 1 28.04.2010 13:11
Access – как сделать универсальную Группировку? jiura Microsoft Office Access 3 26.02.2009 22:10