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

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

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

> Калькулятор в консоли, Калькулятор в консоли, оцените ,если что не так ,то обьясните,недавно
сообщение
Сообщение #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 -


Прикрепленные файлы
Прикрепленный файл  kal.V1.101.pas ( 229 байт ) Кол-во скачиваний: 295
Прикрепленный файл  unit1.pas ( 4.29 килобайт ) Кол-во скачиваний: 306
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 





- Текстовая версия 9.09.2025 2:59
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name