Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
57
Добавлен:
10.05.2014
Размер:
2.61 Кб
Скачать
{$R+}
(*
(c) 2005 Dima Zolotukhin aka 'Zlogic' <zlogic@gmail.com>
Redistributable under GNU GPL license
*)
program formula31337;

type
str_formula = string[100];
str_sy = string[3];
str_message = string[70];
type_value = integer;

function get_string(m:str_message):str_formula;
var
temp_str:str_formula;
begin
write(m,'> ');
readln(temp_str);
get_string:=temp_str;
end;

function find_pos_level(str:str_formula;to_find:str_sy;start:byte):byte;
var
pos_level:byte;
i:byte;
level:byte;
begin
pos_level:=0;
i:=start-1;
level:=1;
while(i<length(str))and not((pos_level<>0)and(level=1))do
begin
i:=i+1;
if(pos('(',copy(str,i,1))<>0)then
level:=level+1;
if(pos(')',copy(str,i,1))<>0)then
level:=level-1;
if(pos(copy(str,i,1),to_find)<>0)and(level=1)then
pos_level:=i;
end;
find_pos_level:=pos_level;
end;

function calc_formula(formula:str_formula;var f_value:type_value):boolean;
var
f1,f2:str_formula;
f1_value,f2_value,temp_value:type_value;
oper:char;
begin
calc_formula:=true;
if(length(formula)=1)then{Ґб«Ё зЁбҐ«Є }
begin
val(formula,f_value,temp_value);{ў®§ўа й Ґ¬ зЁбҐ«Єг}
if(temp_value<>0)then{Ґб«Ё ­Ґ зЁбҐ«Є }
calc_formula:=false;{®иЁЎЄ }
end
else{Ё­ зҐ}
begin
if(copy(formula,1,1)='(')and(copy(formula,length(formula),1)=')')then{Ґб«Ё ­ зЁ­ Ґвбп бЄ®ЎЄ®©}
begin
formula:=copy(formula,2,length(formula)-2);
f1:=copy(formula,1,find_pos_level(formula,'+-*',1)-1);{ЁйҐ¬ ®в бЄ®ЎЄЁ ¤® §­ Є }
f2:=copy(formula,find_pos_level(formula,'+-*',1)+1,length(formula)-find_pos_level(formula,'+-*',1));{ЁйҐ¬
®в §­ Є  ¤® бЄ®ЎЄЁ}
if(length(f1)=0)or(length(f2)=0)then{Ґб«Ё ­Ґ ­ ©¤Ґ­®}
calc_formula:=false{ўлў®¤Ё¬ ®иЁЎЄг}
else{Ё­ зҐ}
begin
oper:=formula[find_pos_level(formula,'+-*',1)];{бзЁв Ґ¬}
calc_formula:=calc_formula(f1,f1_value) and calc_formula(f2,f2_value);
case oper of
'+':f_value:=f1_value+f2_value;
'-':f_value:=f1_value+f2_value;
'*':f_value:=f1_value*f2_value;
end;
end;
end
else{Ё­ зҐ}
calc_formula:=false;{®иЁЎЄ }
end;
end;

var
formula:str_formula;
f_value:type_value;
begin
formula:=get_string('‚ўҐ¤ЁвҐ д®а¬г«г');{Ї®«г祭ЁҐ д®а¬г«л}
if(calc_formula(formula,f_value))then{Ґб«Ё д®а¬г«  ўҐа­ п}
writeln(formula,'=',f_value){ўлў®¤Ё¬ §­ зҐ­ЁҐ}
else{Ё­ зҐ}
writeln('‚ўҐ¤Ґ­­ п бва®Є  ўҐа­®© д®а¬г«®© ­Ґ пў«пҐвбп.');{Ї®бл« Ґ¬ б®®ЎйҐ­ЁҐ}
readln;
end.
Соседние файлы в папке 07