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

ExCode.ru - программирование на высоком уровне

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Ваш интернет-бизнес" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Декабрь 2005   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
LedWorm

Статистика

1.422 подписчиков
-1 за неделю
←   Все выпуски   →

ExCode.ru - программирование на высоком уровне - выпуск 22


Информационный Канал Subscribe.Ru
ExCode.ru - программирование на высоком уровне
Выпуск №22 ( 2005.12.24 )
Здравствуйте, уважаемые подписчики!

Поздравляем Вас с наступающим Новым 2006 Годом, желаем Вам новых идей и новых решений, пусть новый год Вам принесет одни удачи!

Хочу так же напомнить, что декабрь подходит к концу, а это значит, что скоро определяться победители нашего новогоднего конкурса, каждый из которых получит по 2 DVD диска, с ПО для разработчика. Шансы на победу остаются у всех. Все что вам нужно - это зайти на наш сайт и оставить пару сообщений. Удачи!!! Сделайте себе подарок на Новый Год.

Ну и по традиции хотим пригласить Вас в наш кодерский интернет-магазин. Самыи продаваемым диском за последнюю неделю стал диск "E-book библиотека программиста", на данном DVD собрано четыре с половиной гигабайта учебников по программированию.

Новости копьютерного мира:
2005-12-20    Intel и BMW заключили договор о всестороннем партнерстве
Корпорация Intel и группа компаний BMW Group объявили о начале всестороннего партнерства, охватывающего технологическое сотрудничество, совместную маркетинговую деятельность и оказание со стороны Intel спонсорской поддержки команде BMW Sauber F1 Team, участвующей в гонках Формулы 1.

2005-12-19    Вирусы распространились под видом "обновлений" антивирусных программ
Последним занятным поворотом в перипетиях противостояния антивирусных компаний и вирусописателей стало появление в Интернете сайта, маскирующегося под сайт компании McAfee, являющейся одним из популярнейших производителей программного обеспечения для защиты ПК от вирусов и хакерских атак.

2005-12-20    Вирусный альманах за 2005 год
Внимание общественности и средств массовой информации в основном привлекают только вредоносные коды, которым удается вызвать серьезные эпидемии. Тем не менее, каждый день появляется множество новых угроз с собственными, очень индивидуальными чертами. Panda Software представляет список наиболее любопытных вредоносных кодов 2005 года.

2005-12-20    Буш разрешил электронную слежку за американцами
Президент Джордж Буш подписал более 30 указов, санкционирующих электронную слежку за американцами без разрешения суда.

2005-12-20    Первая тысяча в .CO.UA пройдена
Две недели назад началась официальная регистрация имен в новой доменной зоне .CO.UA. И уже этот короткий период в работе регистраторов продемонстрировал популярность нового домена в украинском Интернете - через две недели после начала регистрации было зарегистрировано тысячное доменное имя.

2005-12-20    Сетевые игры - серьезная статья доходов экономики
В настоящее время в мире насчитывается свыше 2 млрд. пользователей сотовых телефонов и около миллиарда пользователей Интернета.

2005-12-20    Мобильный телефон заменит свечи на концертах
Не правда ли впечатляющее зрелище, когда на концерте, во время какой-то слезоточивой песни зрители поднимают над головами свечи (зажигалки) и начинают размахивать ими в темп музыки.

2005-12-20    Стилус от EPOS избавляет от потребности в сенсорном экране
Компания EPOS в ближайшее время собирается продемонстрировать довольно интересное нововведение, которое позволит обеспечить рукописный ввод информации при помощи стилуса в устройства, не обладающие сенсорным экраном. Предполагается, что новая система EPOS особенно понравится компаниям, которые превращают мобильный телефон в электронный бумажник - с помощью стилуса EPOS владелец может подтверждать транзакции своей подписью.

2005-12-20    Успех киноленты предскажет программа
Индийский ученый, профессор Рамеш Шарада (Ramesh Sharda), разработал интересную программу, с помощью которой продюсеры фильмов смогут определить, будут ли их киноленты иметь успех. Ученый, работающий в Университете штата Оклахома, говорит о том, что программа разработана на основе анализа восьмисот фильмов, выпущенных с 1998-го по 2002-й год. Проанализировав все эти киноленты, профессор вывел семь основных критериев, которым должен соответствовать фильм, чтобы стать известным.

2005-12-20    ITC строит первую 3G-сеть в Украине
Киевский CDMA-оператор ITC приступил к строительству первой на Украине сети сотовой связи 3G (EV-DO). Об этом сообщил директор по маркетингу компании ITC Всеволод Валовик.

Статья номера:

Посчитать строку с формулой


В Delphi нет функции, которая бы позволяла посчитать строку с формулой. Но есть множество способов реализовать это самому. Здесь я привел самый простой из них. Он не очень быстрый, но при нынешних скоростях компьютеров для многих целей он подойдет.

Принцип его заключается в следующем. Сначала строка оптимизируется – выкидываются все пробелы, точки и запятые меняются на установленный разделяющий знак (DecimalSeparator). Все числа и параметры (например, x), содержащиеся в строке "обособляются" символом #. В дальнейшем это позволяет избежать путаницы с экспонентой, минусами и. т. д. Следующий шаг – замена, если нужно, всех параметров на их значения. И, наконец, последний шаг, подсчет получившейся строки. Для этого программа ищет все операции с самым высоким приоритетом (это скобки). Считает их значение, вызывая саму себя (рекурсивная функция), и заменяет скобки и их содержимое на их значение, обособленное #. Дальше она выполняет то же самое для операции с более низким приоритетом и так до сложения с вычитанием.

Каждый шаг выделен в отдельную процедуру. Это позволяет быстрее считать функцию, если она не меняется, а меняются только значения параметров.

Вот модуль с этими методами.

Листинг 1. Посчитать строку с формулой


unit Recognition;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Math;

type
TVar = set of char;

procedure Preparation(var s: String; variables: TVar);
function ChangeVar(s: String; c: char; value: extended): String;
function Recogn(st: String; var Num: extended): boolean;

implementation


procedure Preparation(var s: String; variables: TVar);
const
operators: set of char = ['+','-','*', '/', '^'];
var
i: integer;
figures: set of char;
begin
figures := ['0','1','2','3','4','5','6','7','8','9', DecimalSeparator] + variables;

// " "
repeat
i := pos(' ', s);
if i <= 0 then break;
delete(s, i, 1);
until 1 = 0;

s := LowerCase(s);

// ".", ","
if DecimalSeparator = '.' then begin
i := pos(',', s);
while i > 0 do begin
s[i ] := '.';
i := pos(',', s);
end;
end else begin
i := pos('.', s);
while i > 0 do begin
s[i ] := ',';
i := pos('.', s);
end;
end;

// Pi
repeat
i := pos('pi', s);
if i <= 0 then break;
delete(s, i, 2);
insert(FloatToStr(Pi), s, i);
until 1 = 0;

// ":"
repeat
i := pos(':', s);
if i <= 0 then break;
s[ ] := '/';
until 1 = 0;

// |...|
repeat
i := pos('|', s);
if i <= 0 then break;
s[ i] := 'a';
insert('bs(', s, i + 1);
i := i + 3;
repeat i := i + 1 until (i > Length(s)) or (s[i ] = '|');
if s[ i] = '|' then s[ i] := ')';
until 1 = 0;

// #...#
i := 1;
repeat
if s[ i] in figures then begin
insert('#', s, i);
i := i + 2;
while (s[ i] in figures) do i := i + 1;
insert('#', s, i);
i := i + 1;
end;
i := i + 1;
until i > Length(s);
end;

function ChangeVar(s: String; c: char; value: extended): String;
var
p: integer;
begin
result := s;
repeat
p := pos(c, result);
if p <= 0 then break;
delete(result, p, 1);
insert(FloatToStr(value), result, p);
until 1 = 0;
end;

function Recogn(st: String; var Num: extended): boolean;
const
pogr = 1E-5;
var
p, p1: integer;
i, j: integer;
v1, v2: extended;
func: (fNone, fSin, fCos, fTg, fCtg, fArcsin, fArccos, fArctg, fArcctg, fAbs, fLn, fLg, fExp);
Sign: integer;
s: String;
s1: String;

function FindLeftValue(p: integer; var Margin: integer; var Value: extended): boolean;
var
i: integer;
begin
i := p - 1;
repeat i := i - 1 until (i <= 0) or (s[i ] = '#');
Margin := i;
try
Value := StrToFloat(copy(s, i + 1, p - i - 2));
result := true;
except
result := false
end;
delete(s, i, p - i);
end;

function FindRightValue(p: integer; var Value: extended): boolean;
var
i: integer;
begin
i := p + 1;
repeat i := i + 1 until (i > Length(s)) or (s[ i] = '#');
i := i - 1;
s1 := copy(s, p + 2, i - p - 1);
result := TextToFloat(PChar(s1), value, fvExtended);
delete(s, p + 1, i - p + 1);
end;

procedure PutValue(p: integer; NewValue: extended);
begin
insert('#' + FloatToStr(v1) + '#', s, p);
end;

begin
Result := false;
s := st;

// ()
p := pos('(', s);
while p > 0 do begin
i := p;
j := 1;
repeat
i := i + 1;
if s[i ] = '(' then j := j + 1;
if s[i ] = ')' then j := j - 1;
until (i > Length(s)) or (j <= 0);
if i > Length(s) then s := s + ')';
if Recogn(copy(s, p + 1, i - p - 1), v1) = false then Exit;
delete(s, p, i - p + 1);
PutValue(p, v1);

p := pos('(', s);
end;

// sin, cos, tg, ctg, arcsin, arccos, arctg, arcctg, abs, ln, lg, log, exp
repeat
func := fNone;
p1 := pos('sin', s);
if p1 > 0 then begin
func := fSin;
p := p1;
end;
p1 := pos('cos', s);
if p1 > 0 then begin
func := fCos;
p := p1;
end;
p1 := pos('tg', s);
if p1 > 0 then begin
func := fTg;
p := p1;
end;
p1 := pos('ctg', s);
if p1 > 0 then begin
func := fCtg;
p := p1;
end;
p1 := pos('arcsin', s);
if p1 > 0 then begin
func := fArcsin;
p := p1;
end;
p1 := pos('arccos', s);
if p1 > 0 then begin
func := fArccos;
p := p1;
end;
p1 := pos('arctg', s);
if p1 > 0 then begin
func := fArctg;
p := p1;
end;
p1 := pos('arcctg', s);
if p1 > 0 then begin
func := fArcctg;
p := p1;
end;
p1 := pos('abs', s);
if p1 > 0 then begin
func := fAbs;
p := p1;
end;
p1 := pos('ln', s);
if p1 > 0 then begin
func := fLn;
p := p1;
end;
p1 := pos('lg', s);
if p1 > 0 then begin
func := fLg;
p := p1;
end;
p1 := pos('exp', s);
if p1 > 0 then begin
func := fExp;
p := p1;
end;
if func = fNone then break;

case func of
fSin, fCos, fCtg, fAbs, fExp: i := p + 2;
fArctg: i := p + 4;
fArcsin, fArccos, fArcctg: i := p + 5;
else i := p + 1;
end;
if FindRightValue(i, v1) = false then Exit;
delete(s, p, i - p + 1);
case func of
fSin: v1 := sin(v1);
fCos: v1 := cos(v1);
fTg: begin
if abs(cos(v1)) < pogr then Exit;
v1 := sin(v1) / cos(v1);
end;
fCtg: begin
if abs(sin(v1)) < pogr then Exit;
v1 := cos(v1) / sin(v1);
end;
fArcsin: begin
if Abs(v1) > 1 then Exit;
v1 := arcsin(v1);
end;
fArccos: begin
if abs(v1) > 1 then Exit;
v1 := arccos(v1);
end;
fArctg: v1 := arctan(v1);
// fArcctg: v1 := arcctan(v1);
fAbs: v1 := abs(v1);
fLn: begin
if v1 < pogr then Exit;
v1 := Ln(v1);
end;
fLg: begin
if v1 < 0 then Exit;
v1 := Log10(v1);
end;
fExp: v1 := exp(v1);
end;
PutValue(p, v1);
until func = fNone;

// power
p := pos('?^'?, s);
while p > 0 do begin
if FindRightValue(p, v2) = false then Exit;
if FindLeftValue(p, i, v1) = false then Exit;
if (v1 < 0) and (abs(Frac(v2)) > pogr) then Exit;
if (abs(v1) < pogr) and (v2 < 0) then Exit;
delete(s, i, 1);
v1 := Power(v1, v2);
PutValue(i, v1);
p := pos('?^'?, s);
end;

// *, /
p := pos('*', s);
p1 := pos('/', s);
if (p1 > 0) and ((p1 < p) or (p <= 0)) then p := p1;
while p > 0 do begin
if FindRightValue(p, v2) = false then Exit;
if FindLeftValue(p, i, v1) = false then Exit;
if s[i ] = '*'
then v1 := v1 * v2
else begin
if abs(v2) < pogr then Exit;
v1 := v1 / v2;
end;
delete(s, i, 1);
PutValue(i, v1);

p := pos('*', s);
p1 := pos('/', s);
if (p1 > 0) and ((p1 < p) or (p <= 0)) then p := p1;
end;

// +, -
Num := 0;
repeat
Sign := 1;
while (Length(s) > 0) and (s[1] <> '#') do begin
if s[1] = '-' then Sign := -Sign
else if s[1] <> '+' then Exit;
delete(s, 1, 1);
end;
if FindRightValue(0, v1) = false then Exit;
if Sign < 0
then Num := Num - v1
else Num := Num + v1;
until Length(s) <= 0;

Result := true;
end;

end.


А это пример использования этого модуля. Он рисует график функции, введенной в Edit1. Константы left и right определяют края графика, а YScale – масштаб по Y.


Листинг 2. Пример использования


uses Recognition;

procedure TForm1.Button1Click(Sender: TObject);
const
left = -10;
right = 10;
YScale = 50;
var
i: integer;
Num: extended;
s: String;
XScale: single;
col: TColor;
begin
s := Edit1.Text;
preparation(s, ['x']);
XScale := PaintBox1.Width / (right - left);
randomize;
col := RGB(random(100), random(100), random(100));
for i := round(left * XScale) to round(right * XScale) do
if recogn(ChangeVar(s, 'x', i / XScale), Num) then
PaintBox1.Canvas.Pixels[round(i - left * XScale),
round(PaintBox1.Height / 2 - Num * YScale)] := col;
end;


Новые статьи на сайте ExCode.ru:
НазваниеРаздел
TKOLFormDelphi/Pascal » KOL / MCK
OpenGL и Delphi на практикеDelphi/Pascal » Мультимедиа
Использование компонента ClientSocketDelphi/Pascal » Сеть
Распознавание кодировкиDelphi/Pascal » Общие
Ловим баги или Почему программы допускают ошибкиDelphi/Pascal » Общие
Запись сообщений в журнал событий Windows на DelphiDelphi/Pascal » Система
Лицензирование активных форм и ActiveXDelphi/Pascal » Мультимедиа
Управление свойством Font через сервер автоматизацииDelphi/Pascal » Общие
Добавление IPERSISTPROPERTYBAG к активным элементам управленияDelphi/Pascal » Сеть
Гауссово размывание (Gaussian Blur) в Delphi (продолжение) - Создание тениDelphi/Pascal » Мультимедиа
Создаем гипер-ссылку в DelphiDelphi/Pascal » Сеть
Изменение регистраDelphi/Pascal » Общие
Посчитать строку с формулойDelphi/Pascal » Общие
ПерекодированиеDelphi/Pascal » Общие
Выравнивание текстаDelphi/Pascal » Общие
Интерполяция изображенияDelphi/Pascal » Мультимедиа
Сравнительный анализ технологий CORBA и COM - Часть 3Delphi/Pascal » Общие
Сравнительный анализ технологий CORBA и COM - Часть 2Delphi/Pascal » Общие
Сравнительный анализ технологий CORBA и COM - Часть 1Delphi/Pascal » Общие
Пирамидальная сортировка (heapsort)FAQ » Delphi » Синтаксис » Сортировка

Новые файлы на сайте ExCode.ru:
НазваниеРазделРазмерСсылки
TRegAsso
Компонент для регистрации новых расширений файлов и ассоциациии их с определённой программой, а ткаже для проверки зарегистрированности расширения и их удаления....		Компоненты » Delphi1.2 Кб  Скачать
Ведущий рассылки: LedWorm
© ExCode.ru 2005
Subscribe.Ru
Поддержка подписчиков
Другие рассылки этой тематики
Другие рассылки этого автора		 Подписан адрес:
Код этой рассылки: comp.soft.prog.excode
Архив рассылки		 Отписаться Вебом Почтой
Вспомнить пароль
В избранное