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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Калькулятор в консоли, Калькулятор в консоли, оцените ,если что не так ,то обьясните,недавно
zmeiko
сообщение 22.01.2012 15:24
Сообщение #1





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

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


вот сам модуль, если можно как-то оптимизировать
unit unit1;

interface

procedure DelElem(var arr: array of char; i: integer);
procedure DelElemnum(var arr: array of real; i: integer);
function Kalkulator(orig: string): real;
function NUM1(orig: string): real;
implementation

procedure DelElem(var arr: array of char; i: integer);
var
j: integer;
begin
for j := i to length(arr) - 2 do
arr[j] := arr[j + 1];
setlength(arr, length(arr) - 1);
end;

procedure DelElemnum(var arr: array of real; i: integer);
var
j, h: integer;
cop: array of real;
begin
setlength(cop, length(arr) - 1);
for j := 0 to length(cop) - 1 do
if j <> i then

begin
cop[j] := arr[j];
end
else
begin
h := j;
break;
end;
for j := h to length(cop) - 1 do
cop[j] := arr[j + 1];
setlength(arr, length(cop));
arr := cop;
end;

function Kalkulator(orig: string): real;
label 1;
var
Tarr: array of char;
cop: string;
num: array of real;
i, h, g, po, p, j: integer;
perem: string;
res: real;
bool: boolean;
begin
cop := orig; res := 0; h := 0; p := 0; g := -1; po := 0;
for i := 1 to length(cop) do
if (cop[i] = '*') or (cop[i] = '/') or (cop[i] = '+') or (cop[i] = '-') then //проверка на существование знаков *, / , - , +
begin
setlength(tarr, h + 1); //если есть то заносим их в массив-Tarr
tarr[h] := cop[i];
po := g + 2;//определяем начало и
p := i - 1;//конец значений позийций числа
perem := '';
perem := copy(orig, po, p - po + 1);//записываем число ввиде строки в Perem
setlength(num, h + 1);//добавляем это число в массив
if trystrtofloat(perem, num[h]) = false then
begin
writeln('Невозможно считать строку убедитеть что ввели все без ошибок и повторите еще раз');//Если нельзя то выводим сообщение об ошибке
result := 0;
exit;
end;
g := p;
h := h + 1;
end;
setlength(num, h + 1);//Из за особенности пердыдущего кода последняя цифра не считвыется ,этот код для нее
po := g + 2;
p := length(orig);
perem := copy(orig, po, p - po + 1);
num[h] := strtofloat(perem); //разбор на состовляюшие
if length(tarr) = 1 then //ели у нас одна операция то переходим к ее выполнению т.е к метке 1
goto 1;


repeat //решаем умножение и деление
if length(tarr) = 0 then
goto 1;// если в примере было только умножение или деление то перходим в метке 1

for i := 0 to length(tarr) - 1 do

case tarr[i] of
'*':
begin
unit1.DelElem(tarr, i); //удаляем символ из массива
res := num[i] * num[i + 1];//решаем
unit1.DelElemnum(num, i); //заменяем 2 множителя на их произведение
num[i] := res;
bool := false; //показывает что в массиве еще могут быть знаки * и /
break;
end;
'/':
begin
res := num[i] / num[i + 1]; //аналогично множению
unit1.DelElem(tarr, i);
unit1.DelElemnum(num, i);
num[i] := res; bool := false;
break;
end

else
bool := true;// в массиве нету * и /
end;
until bool <> false;
1: //метка 1
result := num[0];//досчитвываем получившиеся числа
if length(tarr) <> 0 then
begin
for i := 0 to length(tarr) - 1 do
case tarr[i] of
'+': result := result + num[i + 1];
'-': result := result - num[i + 1];
'*': result := result * num[i + 1];
'/': result := result / num[i + 1];
end
end;
end;

function NUM1(orig: string): real;//функция для рашение примеров со скобками
var
cop: string;
bool: boolean;
res: real;
Re: string;
i, j, lan, k, g: integer;
begin
repeat
bool := true;
for i := 1 to length(orig) do
if orig[i] = '(' then //если есть скобка то ищщем ее конец
begin
k := i;
for j := k to length(orig) do
if orig[j] = ')' then
begin
Re := copy(orig, i + 1, j - i - 1);//привер в скобках отдаем решать функции Kalkulator
lan := length(re) + 2;
delete(orig, i, lan);//удаляем скобки и то что между ними ----------------------------
inc(g); // |
res := unit1.Kalkulator(Re); // |
if (g = 1) and (i = 1) then //если это скобка стоит в начале то (1+2)+6 = 3+6 |
orig := floattostr(res) + orig // |
else // |
begin{если нет то 6++12= так как мы удаляем скобки и то что между ними ------------
6 + = копируем все что стояло после скобок в cop
6 + = удаляем это
6+3= добваляем результат в скобках
6+3+12 и переменную сор }
cop := copy(orig, i, length(orig) - i + 1);
delete(orig, i, length(orig) - i + 1);
orig := orig + floattostr(res) + cop;
end;
bool := false;//показывет что еще есть скобки
break;
end
else
begin

bool := true;//что скобок нет
end;
break;
end
else
if i = length(orig) then
begin
bool := true;//что скобок нет
break;
end;

until bool = true;
result := Kalkulator(orig);//передаем полученные числа функции Kalkulator
end;

begin
end.

Сообщение отредактировано: zmeiko - 22.01.2012 15:26


Прикрепленные файлы
Прикрепленный файл  kal.V1.101.pas ( 229 байт ) Кол-во скачиваний: 177
Прикрепленный файл  unit1.pas ( 4.29 килобайт ) Кол-во скачиваний: 195
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
IUnknown
сообщение 23.01.2012 12:15
Сообщение #2


a.k.a. volvo877
*****

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

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


Цитата
1+(3*4 - 11+4*7)*2+(1-6)
Невозможно считать строку убедитеть что ввели все без ошибок и повторите еще раз
Это так и задумано, что калькулятор не умеет работать с отрицательными числами?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 20.07.2025 2:33
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"