Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

СообЧА. Программирование на Delphi


Информационный Канал Subscribe.Ru

СообЧА : Пока на плаву...(Учебно -математический выпуск)

Сегодня в номере :

С днем рожденья!!!

Возведение числа в степень
Вычислитель математических формул

Фонд поддержки наших проектов и рассылки:
Получатель: ИНН 7707083893 Новгородское ОСБ № 8629
Счет получателя: 47422810343029900030
Банк получателя
:Новгородское ОСБ № 8629 г.Великий Новгород 30101810100000000698
Бик 044959698

Рассылки Subscribe.Ru это стильно удобно, и информативно!
СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.


подпишись и подпиши друга!!!!

 Contact (Связь с Нами):

Pixel@novgorod.net + Subject: (см ниже)

 

Vcl Haunting

"Золотой Чайник"

Вопрос по дельфи N (N номер версии)

Help!

Реклама

Полезный линк

 

Наш сайт : pixelsoft.narod.ru

Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...

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

Пожалуй лучший учебник по дельфи 6 на сегодняшний день, вам даже не надо знать дельфи, чтобы начать ...

  • Дельфи 5: Руководство разработчика БД
  •  

    DirectX. Графика в проектах Delphi (+CD - ROM)
    Лучшее пособие для тех кто решил связаться с DirectX, по слухам на CD помимо примеров есть DirectxSDK7.0 от Microsoft...

    Среда программирования Delphi 5-6. Справочное пособие
    Книга полностью описывает среду программирования Delphi, которая включает в себя полный набор визуальных инструментов для быстрой и профессиональной разработки приложений для различных операционных систем, кроме того рассмотрены проблемы перехода между этими версиями дельфи.

    Программирование в Delphi 6 (+ floppy дискета ) Чайникам рекомендуется!!!

    Книга содержит методические и справочные материалы по новой версии системы визуального объектно-ориентированного программирования Delphi 6 и предшествующим версиям Delphi 5 и 4. Рассмотрены такие новые возможности Delphi, как кросс-платформенные приложения, технологии доступа к данным ADO, InterBase Express, dbExpress, компоненты ; серверы СОМ, технологии распределенных приложений СОМ, CORBA, MIDAS, новая методика диспетчеризации действий...


С днем рожденья!!!

На днях у сайта "Первые Шаги", посвященного программированию случилась третья годовщина с момента появления.
С днем рожденья , коллеги...

Любителям Дельфи сайт вряд-ли будет полезен, но тем , кто желает изучить BorlandC++5.0 (близнец дельфи) сайт будет очень кстати . К вашему вниманию предлагают пошаговый курс изучения С++ , от азов (создание пустого окна с кнопочкой ) до сверхмощного текстового редактора а-ля Word.

Помимо BCB на сайте так же рассматриваются следующие темы:

TASM
Html&WEB
VRML
Java
CGI
Linux
Visual C++
Справка WinAPI
Visual Basic
Visual FoxPro
C Sharp & .NET
C++ Builder
VBA by Step
1C
GIS
SQL by Step
Algorithms
Security
Protocols
MS Office

Вот поледние обноления сайта:

1.09.2002
1C: "Шаг 230 - Сетевая версия"
1C: "Шаг 231 - Чем хороша Административная установка"
1C: "Шаг 232 - Отчет по регистрам, где взять"
1C: "Шаг 233 - Универсальные отчеты - первый шаг"
VC++(Direct3D): "Шаг 17 - Вращаем направленный источник света вокруг треугольника"
VC++(Direct3D): "Шаг 18 - Деревянная стена или плоское покрытие текстурой"
VC++(DirectX-Справка): "Шаг 68 - Текстурная функция D3DXCreateTextureFromFile"
VC++(DirectX-Справка): "Шаг 69 - IDirect3DDevice8::SetTexture"

31.08.2002
1C: "Шаг 226 - Что такое ОКУД"
1C: "Шаг 227 - Что такое ОКПО"
1C: "Шаг 228 - Анализ по субконто - изучаем"
1C: "Шаг 229 - Анализ счета по субконто - АнализСчетаПоСубконто"
1C(Народная Бухгалтерия): "Шаг 7 - Описание данных, с которыми работает "Администратор Пользователей""
C++Builder: "Шаг 78 - Создание компонентов или Как делаются кирпичи для Вавилонской башни"
C++Builder: "Шаг 79 - Shell extensions"
VC++(DirectX-Справка): "Шаг 63 - IDirect3DDevice8::SetLight"
VC++(DirectX-Справка): "Шаг 64 - IDirect3DDevice8::LightEnable"
VC++(DirectX-Справка): "Шаг 65 - Описание структуры D3DMATERIAL8"
VC++(DirectX-Справка): "Шаг 66 - IDirect3DDevice8::SetMaterial"
VC++(DirectX-Справка): "Шаг 67 - Описание интерфейса IDirect3DTexture8"

30.08.2002
1C: "Шаг 224 - Чем может помочь монитор пользователей"
1C: "Шаг 225 - Изучаем справочники - Запрет ручного исправления"
C++Builder: "Шаг 75 - Расширения стандарта ANSI C++ - Свойства"
C++Builder: "Шаг 76 - Расширения стандарта ANSI C++ - Свойства, продолжение"
C++Builder: "Шаг 77 - Расширения стандарта ANSI C++ - Операторы"
Visual FoxPro: "Шаг 49 - Замораживаем форму"
VC++(Direct3D): "Шаг 15 - Устанавливаем направленный источник света"
VC++(Direct3D): "Шаг 16 - Назначим материалы"
VC++(DirectX-Справка): "Шаг 58 - Описание перечисляемого типа D3DZBUFFERTYPE"
VC++(DirectX-Справка): "Шаг 59 - Описание структуры D3DLIGHT8"
VC++(DirectX-Справка): "Шаг 60 - Описание перечисляемого типа D3DLIGHTTYPE"
VC++(DirectX-Справка): "Шаг 61 - Описание структуры D3DCOLORVALUE"
VC++(DirectX-Справка): "Шаг 62 - Математическая функция D3DXVec3Normalize"

29.08.2002
Сегодня у нас день рожденья. Нам исполняется 3 года. Поздравляю всех с этим событием.
1C: "Шаг 220 - Таблица для печати - обратим внимание на шаблон"
1C: "Шаг 221 - Использование запроса для перебора"
1C: "Шаг 222 - Как узнать в каком файле DBF хранятся данные"
1C: "Шаг 223 - Боремся с удаленными записями - третий способ (правильный)"
VC++(Direct3D): "Шаг 13 - Вращаем разноцветный трехмерный треугольник"
VC++(Direct3D): "Шаг 14 - Используем буфер глубины (Z-буфер)"

28.08.2002
1C: "Шаг 214 - Короткое Если или чем может помочь знак вопроса"
1C: "Шаг 215 - Что такое перечисление"
1C: "Шаг 216 - Боремся с удаленными записями - первый способ"
1C: "Шаг 217 - Боремся с удаленными записями - второй способ"
1C: "Шаг 218 - От перебора документов к запросу"
1C: "Шаг 219 - От перебора документов к запросу дальше"
VC++(DirectX-Справка): "Шаг 51 - Математическая функция D3DXMatrixRotationX"
VC++(DirectX-Справка): "Шаг 52 - Математическая функция D3DXMatrixRotationZ"
VC++(DirectX-Справка): "Шаг 53 - IDirect3DDevice8::SetRenderState"
VC++(DirectX-Справка): "Шаг 54 - Описание перечисляемого типа D3DRENDERSTATETYPE"
VC++(DirectX-Справка): "Шаг 55 - Описание перечисляемого типа D3DSHADEMODE"
VC++(DirectX-Справка): "Шаг 56 - Что такое матрица?"
VC++(DirectX-Справка): "Шаг 57 - Перемещение, масштабирование и повороты в трехмерном пространстве"

27.08.2002
1C: "Шаг 211 - Что такое сторнирование"
1C: "Шаг 212 - Удаление данных из 1C, что реально происходит"
1C: "Шаг 213 - Стандартные отчеты в нашу конфигурацию - какие будут проблемы"
Visual FoxPro: "Шаг 48 - OLE+VFP+InternetExplorer"
VC++(DirectX-Справка): "Шаг 46 - Описание структуры D3DXVECTOR3"
VC++(DirectX-Справка): "Шаг 47 - Описание структуры D3DVECTOR"
VC++(DirectX-Справка): "Шаг 48 - Математическая функция D3DXMatrixPerspectiveFovLH"
VC++(DirectX-Справка): "Шаг 49 - Математическая функция D3DXMatrixPerspectiveFovRH"
VC++(DirectX-Справка): "Шаг 50 - Математическая функция D3DXMatrixLookAtRH"

26.08.2002
Рассылка новостей сайта от 26-08-2002.
1C: "Шаг 209 - 1С против калькулятора - округление"
1C: "Шаг 210 - Как сделать разные типы журналов"
Visual FoxPro: "Шаг 47 - OLE+VFP+Word"
VC++(DirectX-Справка): "Шаг 41 - IDirect3DDevice8::SetTransform"
VC++(DirectX-Справка): "Шаг 42 - Описание перечисляемого типа D3DTRANSFORMSTATETYPE"
VC++(DirectX-Справка): "Шаг 43 - Описание макроса D3DTS_WORLD"
VC++(DirectX-Справка): "Шаг 44 - Описание макроса D3DTS_WORLDMATRIX"
VC++(DirectX-Справка): "Шаг 45 - Математическая функция D3DXMatrixLookAtLH"

25.08.2002
1C: "Шаг 203 - Отладка, вариант первый"
1C: "Шаг 204 - Отладка, вариант второй"
1C: "Шаг 205 - Второй вариант отладки - только в монопольном режиме"
1C: "Шаг 206 - Отладка - использование отладчика"
1C: "Шаг 207 - Все ли элементы можно сохранить в документе"
1C: "Шаг 208 - Так что же делать с переключателем"
Visual FoxPro: "Шаг 45 - OLE+VFP+Excel. Получаем имена открытых книг"
Visual FoxPro: "Шаг 46 - OLE+VFP+Excel. Меняем значения ячеек"
Linux(GTK): "Шаг 15 - Всплывающие подсказки"
VC++(DirectX-Справка): "Шаг 36 - IDirect3DDevice8::TestCooperativeLevel"
VC++(DirectX-Справка): "Шаг 37 - IDirect3DDevice8::Reset"
VC++(DirectX-Справка): "Шаг 38 - Описание структуры D3DMATRIX"
VC++(DirectX-Справка): "Шаг 39 - Математическая функция D3DXMatrixRotationY"
VC++(DirectX-Справка): "Шаг 40 - Описание структуры D3DXMATRIX"

23.08.2002
1C: "Шаг 196 - Передача параметров в процедуры"
1C: "Шаг 197 - Решаем задачу обратного расчета"
1C: "Шаг 198 - Процедуры и функции обратного хода"
1C: "Шаг 199 - Когда происходят события"
1C: "Шаг 200 - Доступность элемента из процедуры"
1C: "Шаг 201 - Пара слов о синтаксисе помощника"
1C: "Шаг 202 - Чем хороша лицензионная версия, как убедить директора"
Visual FoxPro: "Шаг 44 - OLE+VFP+Excel"
VC++(DirectX-Справка): "Шаг 32 - IDirect3DDevice8::DrawPrimitive"
VC++(DirectX-Справка): "Шаг 33 - Описание перечисляемого типа D3DPRIMITIVETYPE"
VC++(DirectX-Справка): "Шаг 34 - Список треугольников"
VC++(DirectX-Справка): "Шаг 35 - Треугольники в виде веера"



Возведение числа в степень N

Возведение числа в степень

В: Это может звучать тривиально, но как мне возвести число в степень? Например, 2^12 = 4095.
На самом деле вопрос далеко не тривиальный. Проблема в том, что сам алгоритм функции далеко не прост. Функцией Power(X, N) (т.е. X^N) должны четко отслеживаться несколько возможных ситуаций:


X любое число, N = 0
X = 1, N любое число
X = 0 и N > 0
X = 0 и N < 0
X > 0
X < 0 и N нечетное целое
X < 0 и N целое
X < 0 и N нецелое
Посмотрите на следующую, абсолютно правильно работающую функцию (тем не менее она может быть и не самой эффективной!):


--------------------------------------------------------------------------------
interface

type

EPowerException = class(Exception)
end;


implementation

function Power(X, N : real) : extended; var

t : longint;
r : real;
isInteger : boolean;
begin


if N = 0 then begin
result := 1.0;
exit;
end;


if X = 1.0 then begin
result := 1.0;
exit;
end;


if X = 0.0 then begin
if N > 0.0 then
begin
result := 0.0;
exit;
end
else
raise EPowerException.Create('Результат - бесконечность');
end;


if (X > 0) then
try
result := exp(N * ln(X));
exit;
except
raise EPowerException.Create('Результат - переполнение или потеря значимости');
end;


{ X - отрицательный, но мы все еще можем вычислить результат, если n целое. }
{ пытаемся получить целую часть n с использованием типа longint, вычисление }
{ четности n не займет много времени }

try
t := trunc(n);
if (n - t) = 0 then
isInteger := true
else
isInteger := False;
except
{ Лишний бит может вызвать переполнение или потерю значимости }
r := int(n);
if (n - r) = 0 then
begin
isInteger := true;
if frac(r/2) = 0.5 then
t := 1
else
t := 2;
end
else
isInteger := False;
end;


if isInteger then
begin
{n целое}
if odd(t) then
{n нечетное}
try
result := -exp(N * ln(-X));
exit;
except
raise EPowerException.Create('Результат - переполнение или потеря значимости');
end
else
{n четное}
try
result := exp(N * ln(-X));
exit;
except
raise EPowerException.Create('Результат - переполнение или потеря значимости');
end;
end
else
raise EPowerException.Create('Результат невычисляем');

end;




Вычислитель математических формул

Учитывая ,что на дворе сентябрь я думаю данная прога лишней не будет :)...

Вот что я обнаружил несколько дней назад при просмотре зарубежных источников:
FORMULA должна быть стокой, содержащей формулу. Допускаются переменные x, y и z, а также операторы, перечисленные ниже. Пример:

--------------------------------------------------------------------------------
sin(x)*cos(x^y)+exp(cos(x))

Использование:


--------------------------------------------------------------------------------
uses EVALCOMP;

var calc: EVALVEC ; (evalvec - указатель на объект, определяемый evalcomp)

FORMULA: string;

begin

FORMULA:='x+y+z';

new (calc,init(FORMULA)); (Построение дерева оценки)

writeln ( calc^.eval1d(7) ) ; (x=7 y=0 z=0; result: 7)
writeln ( calc^.eval2d(7,8) ) ; (x=7 y=8 z=0; result: 15)
writeln ( calc^.eval3d(7,8,9) ) ; (x=7 y=8 z=9; result: 24)

dispose(calc,done); (разрушение дерева оценки)

end.

Допустимые операторы:

--------------------------------------------------------------------------------
x <l;> y ; Логические операторы возвращают 1 в случае истины и 0 если ложь.
x <l;= y
x >= y
x > y
x <l; y
x = y
x + y
x - y
x eor y ( исключающее или )
x or y
x * y
x / y
x and y
x mod y
x div y
x ^ y ( степень )
x shl y
x shr y
not (x)
sinc (x)
sinh (x)
cosh (x)
tanh (x)
coth (x)
sin (x)
cos (x)
tan (x)
cot (x)
sqrt (x)
sqr (x)
arcsinh (x)
arccosh (x)
arctanh (x)
arccoth (x)
arcsin (x)
arccos (x)
arctan (x)
arccot (x)
heavy (x) ; 1 для положительных чисел, 0 для остальных
sgn (x) ; 1 для положительных чисел, -1 для отрицательных и 0 для нуля
frac (x)
exp (x)
abs (x)
trunc (x)
ln (x)
odd (x)
pred (x)
succ (x)
round (x)
int (x)
fac (x) ; x*(x-1)*(x-2)*...*3*2*1
rnd ; Случайное число в диапазоне [0,1]
rnd (x) ; Случайное число в диапазоне [0,x]
pi
e

--------------------------------------------------------------------------------
unit evalcomp;

interface

type fun= function(x,y:real):real;

evalvec= ^evalobj;
evalobj= object
f1,f2:evalvec;
f1x,f2y:real;
f3:fun;
function eval:real;
function eval1d(x:real):real;
function eval2d(x,y:real):real;
function eval3d(x,y,z:real):real;
constructor init(st:string);
destructor done;
end;
var evalx,evaly,evalz:real;

implementation

var analysetmp:fun;

function search (text,code:string; var pos:integer):boolean;
var i,count:integer;

flag:boolean;
newtext:string;
begin

if length(text)<l;length(code) then begin search:=false; exit; end;
flag:=false;
pos:=length(text)-length(code)+1;
repeat
if code=copy(text,pos,length(code))
then flag:=true
else dec(pos);
if flag
then
begin
count:=0;
for i:= pos+1 to length(text) do
begin
if copy(text,i,1) = '(' then inc(count);
if copy(text,i,1) = ')' then dec(count);
end;
if count<l;>0
then
begin
dec(pos);
flag:=false;
end;
end;
until (flag=true) or (pos=0);
search:=flag;
end;

function myid(x,y:real):real;
begin

myid:=x;
end;

function myunequal(x,y:real):real;
begin

if x<>y then
myunequal:=1
else
myunequal:=0;
end;

function mylessequal(x,y:real):real;
begin

if x<=y then
mylessequal:=1
else
mylessequal:=0;
end;

function mygreaterequal(x,y:real):real;
begin

if x>=y then
mygreaterequal:=1
else
mygreaterequal:=0;
end;

function mygreater(x,y:real):real;
begin

if x>y then
mygreater:=1
else
mygreater:=0;
end;

function myless(x,y:real):real;
begin

if x<y then
myless:=1
else
myless:=0;
end;

function myequal(x,y:real):real;
begin

if x=y then
myequal:=1
else
myequal:=0;
end;

function myadd(x,y:real):real;
begin

myadd:=x+y;
end;

function mysub(x,y:real):real;
begin

mysub:=x-y;
end;

function myeor(x,y:real):real;
begin

myeor:=trunc(x) xor trunc(y);
end;

function myor(x,y:real):real;
begin

myor:=trunc(x) or trunc(y);
end;

function mymult(x,y:real):real;
begin

mymult:=x*y;
end;

function mydivid(x,y:real):real;
begin

mydivid:=x/y;
end;

function myand(x,y:real):real;
begin

myand:=trunc(x) and trunc(y);
end;

function mymod(x,y:real):real;
begin

mymod:=trunc(x) mod trunc(y);
end;

function mydiv(x,y:real):real;
begin

mydiv:=trunc(x) div trunc(y);
end;

function mypower(x,y:real):real;
begin

if x=0 then
mypower:=0
else
if x>0 then
mypower:=exp(y*ln(x))
else
if trunc(y)<>y then
begin
writeln (' Немогу вычислить x^y ');
halt;
end
else
if odd(trunc(y))=true then
mypower:=-exp(y*ln(-x))
else
mypower:=exp(y*ln(-x))
end;

function myshl(x,y:real):real;
begin

myshl:=trunc(x) shl trunc(y);
end;

function myshr(x,y:real):real;
begin

myshr:=trunc(x) shr trunc(y);
end;

function mynot(x,y:real):real;
begin

mynot:=not trunc(x);
end;

function mysinc(x,y:real):real;
begin
if x=0 then

mysinc:=1
else

mysinc:=sin(x)/x
end;

function mysinh(x,y:real):real;
begin
mysinh:=0.5*(exp(x)-exp(-x))
end;

function mycosh(x,y:real):real;
begin
mycosh:=0.5*(exp(x)+exp(-x))
end;

function mytanh(x,y:real):real;
begin
mytanh:=mysinh(x,0)/mycosh(x,0)
end;

function mycoth(x,y:real):real;
begin
mycoth:=mycosh(x,0)/mysinh(x,0)
end;

function mysin(x,y:real):real;
begin
mysin:=sin(x)
end;

function mycos(x,y:real):real;
begin
mycos:=cos(x)
end;

function mytan(x,y:real):real;
begin
mytan:=sin(x)/cos(x)
end;

function mycot(x,y:real):real;
begin
mycot:=cos(x)/sin(x)
end;

function mysqrt(x,y:real):real;
begin
mysqrt:=sqrt(x)
end;

function mysqr(x,y:real):real;
begin
mysqr:=sqr(x)
end;

function myarcsinh(x,y:real):real;
begin
myarcsinh:=ln(x+sqrt(sqr(x)+1))
end;

function mysgn(x,y:real):real;
begin
if x=0 then

mysgn:=0
else

mysgn:=x/abs(x)
end;

function myarccosh(x,y:real):real;
begin
myarccosh:=ln(x+mysgn(x,0)*sqrt(sqr(x)-1))
end;

function myarctanh(x,y:real):real;
begin
myarctanh:=ln((1+x)/(1-x))/2
end;

function myarccoth(x,y:real):real;
begin
myarccoth:=ln((1-x)/(1+x))/2
end;

function myarcsin(x,y:real):real;
begin
if x=1 then

myarcsin:=pi/2
else

myarcsin:=arctan(x/sqrt(1-sqr(x)))
end;

function myarccos(x,y:real):real;
begin
myarccos:=pi/2-myarcsin(x,0)
end;

function myarctan(x,y:real):real;
begin
myarctan:=arctan(x);
end;

function myarccot(x,y:real):real;
begin
myarccot:=pi/2-arctan(x)
end;

function myheavy(x,y:real):real;
begin
myheavy:=mygreater(x,0)
end;

function myfrac(x,y:real):real;
begin
myfrac:=frac(x)
end;

function myexp(x,y:real):real;
begin
myexp:=exp(x)
end;

function myabs(x,y:real):real;
begin
myabs:=abs(x)
end;

function mytrunc(x,y:real):real;
begin
mytrunc:=trunc(x)
end;

function myln(x,y:real):real;
begin
myln:=ln(x)
end;

function myodd(x,y:real):real;
begin
if odd(trunc(x)) then

myodd:=1
else

myodd:=0;
end;

function mypred(x,y:real):real;
begin
mypred:=pred(trunc(x));
end;

function mysucc(x,y:real):real;
begin
mysucc:=succ(trunc(x));
end;

function myround(x,y:real):real;
begin
myround:=round(x);
end;

function myint(x,y:real):real;
begin
myint:=int(x);
end;

function myfac(x,y:real):real;
var n : integer;

r : real;
begin
if x<0 then begin writeln(' Немогу вычислить факториал '); halt; end;
if x = 0 then myfac := 1
else

begin
r := 1;
for n := 1 to trunc ( x ) do
r := r * n;
myfac:= r;
end;
end;

function myrnd(x,y:real):real;
begin
myrnd:=random;
end;

function myrandom(x,y:real):real;
begin
myrandom:=random(trunc(x));
end;

function myevalx(x,y:real):real;
begin
myevalx:=evalx;
end;

function myevaly(x,y:real):real;
begin
myevaly:=evaly;
end;

function myevalz(x,y:real):real;
begin
myevalz:=evalz;
end;

procedure analyse (st:string; var st2,st3:string);
label start;

var pos:integer;
value:real;
newterm,term:string;
begin
term:=st;
start:

if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
newterm:='';
for pos:= 1 to length(term) do
if copy(term,pos,1)<>' ' then newterm:=newterm+copy(term,pos,1);
term:=newterm;
if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
val(term,value,pos);
if pos=0 then begin
analysetmp:=myid;
st2:=term;
st3:='';
exit;
end;
if search(term,'<>',pos) then begin
analysetmp:=myunequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'<=',pos) then begin
analysetmp:=mylessequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>=',pos) then begin
analysetmp:=mygreaterequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>',pos) then begin
analysetmp:=mygreater;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'<',pos) then begin
analysetmp:=myless;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'=',pos) then begin
analysetmp:=myequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'+',pos) then begin
analysetmp:=myadd;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'-',pos) then begin
analysetmp:=mysub;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'eor',pos) then begin
analysetmp:=myeor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'or',pos) then begin
analysetmp:=myor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'*',pos) then begin
analysetmp:=mymult;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'/',pos) then begin
analysetmp:=mydivid;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'and',pos) then begin
analysetmp:=myand;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'mod',pos) then begin
analysetmp:=mymod;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'div',pos) then begin
analysetmp:=mydiv;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'^',pos) then begin
analysetmp:=mypower;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'shl',pos) then begin
analysetmp:=myshl;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'shr',pos) then begin
analysetmp:=myshr;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if copy(term,1,1)='(' then begin
term:=copy(term,2,length(term)-2);
goto start;
end;
if copy(term,1,3)='not' then begin
analysetmp:=mynot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sinc' then begin
analysetmp:=mysinc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='sinh' then begin
analysetmp:=mysinh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='cosh' then begin
analysetmp:=mycosh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='tanh' then begin
analysetmp:=mytanh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='coth' then begin
analysetmp:=mycoth;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sin' then begin
analysetmp:=mysin;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cos' then begin
analysetmp:=mycos;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='tan' then begin
analysetmp:=mytan;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cot' then begin
analysetmp:=mycot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sqrt' then begin
analysetmp:=mysqrt;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sqr' then begin
analysetmp:=mysqr;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,7)='arcsinh' then begin
analysetmp:=myarcsinh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccosh' then begin
analysetmp:=myarccosh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arctanh' then begin
analysetmp:=myarctanh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccoth' then begin
analysetmp:=myarccoth;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,6)='arcsin' then begin
analysetmp:=myarcsin;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccos' then begin
analysetmp:=myarccos;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arctan' then begin
analysetmp:=myarctan;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccot' then begin
analysetmp:=myarccot;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,5)='heavy' then begin
analysetmp:=myheavy;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='sgn' then begin
analysetmp:=mysgn;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='frac' then begin
analysetmp:=myfrac;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='exp' then begin
analysetmp:=myexp;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='abs' then begin
analysetmp:=myabs;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,5)='trunc' then begin
analysetmp:=mytrunc;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,2)='ln' then begin
analysetmp:=myln;
st2:=copy(term,3,length(term)-2);
st3:='';
exit;
end;
if copy(term,1,3)='odd' then begin
analysetmp:=myodd;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='pred' then begin
analysetmp:=mypred;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='succ' then begin
analysetmp:=mysucc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,5)='round' then begin
analysetmp:=myround;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='int' then begin
analysetmp:=myint;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='fac' then begin
analysetmp:=myfac;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='rnd' then begin
analysetmp:=myrnd;
st2:='';
st3:='';
exit;
end;
if copy(term,1,3)='rnd' then begin
analysetmp:=myrandom;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='x' then begin
analysetmp:=myevalx;
st2:='';
st3:='';
exit;
end;
if term='y' then begin
analysetmp:=myevaly;
st2:='';
st3:='';
exit;
end;
if term='z' then begin
analysetmp:=myevalz;
st2:='';
st3:='';
exit;
end;
if (term='pi') then begin
analysetmp:=myid;
str(pi,st2);
st3:='';
exit;
end;
if term='e' then begin
analysetmp:=myid;
str(exp(1),st2);
sst3:='';
exit;
end;
writeln(' ВНИМАНИЕ : НЕДЕКОДИРУЕМАЯ ФОРМУЛА ');
analysetmp:=myid;
st2:='';
st3:='';
end;

function evalobj.eval:real;
var tmpx,tmpy:real;
begin

if f1=nil then
tmpx:=f1x
else
tmpx:=f1^.eval;
if f2=nil then
tmpy:=f2y
else
tmpy:=f2^.eval;
eval:=f3(tmpx,tmpy);
end;

function evalobj.eval1d(x:real):real;
begin
evalx:=x;
evaly:=0;
evalz:=0;
eval1d:=eval;
end;

function evalobj.eval2d(x,y:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=0;
eval2d:=eval;
end;

function evalobj.eval3d(x,y,z:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=z;
eval3d:=eval;
end;

constructor evalobj.init(st:string);
var st2,st3:string;

error:integer;
begin
f1:=nil;
f2:=nil;
analyse(st,st2,st3);
f3:=analysetmp;
val(st2,f1x,error);
if st2='' then
begin

f1x:=0;
error:=0;
end;
if error<>0 then

new (f1,init(st2));
val(st3,f2y,error);
if st3='' then
begin

f2y:=0;
error:=0;
end;
if error<>0 then

new (f2,init(st3));
end;

destructor evalobj.done;
begin
if f1<>nil then

dispose(f1,done);
if f2<>nil then

dispose(f2,done);
end;

end.




http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное