Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.11.2012, 22:17   #1
Олесенька
Пользователь
 
Регистрация: 12.11.2012
Сообщений: 12
Восклицание нужно исправить ошибку!pascal

Пишу калькулятор."шестнадцатеричный калькулятор"
в старой минимальной версии паскаля абс работает,и считает правильно.
пришлось установить новую полную версию паскаля абс net для создания ехе файла. запускаю эту же программу и результат выполнения любого выражения всегда = 0. в чём может быть проблема. где может быть ошибка.

Код:
Program kursach;
var
n: integer;
allst, gotst: string;
cl: boolean;
result, data: text;
Procedure StProc (allst: string; var gotst: string);
var
i, zn1, zn2: integer;
mainzn: char;
st1, st2, dec: string;
{Функция положительной степени числа}
function stepen (x,n: integer): longint;
var
k: longint;
i: integer;
begin
k:=1;
for i:=1 to n do k:=k*x;
stepen:=k;
end;
{Функция отрицательной степени числа}
function minus_stepen (x,n: integer): real;
var
k: longint;
i: integer;
begin
k:=1;
for i:=1 to n do k:=k*x;
minus_stepen:=1/k;
end;
{Функчия перевода 16сс числа в 10сс}
function _16to10 (s: string): real;
var
m,n,z: longint;
i,num: integer;
ost: string;
drobch,res: real;
begin
drobch:=0;
m:=0;
num:=0;
{Проверяем, целое ли это число}
for i:=1 to length (s) do
if (s [i] ='. ') or (s [i] =',')
then
num:=i;
if num<>0
then
begin
ost:=copy (s,num+1,length (s) - num); {Создаем переменную с остатком}
delete (s,num,length (s) - num+1); {Выделяем целую часть}
{####### Переводим дробную часть #########}
n:=0;
for i:=1 to length (ost) do
begin
z:=0;
val (ost [i],n,z);
if z<>0 then n:=10+ord (UpCase (s [i])) - ord ('A');
drobch:=drobch+minus_stepen (16, i) *n;
end;
end;
n:=0;
{######## Переводим целую часть #########}
for i:=1 to length (s) do
begin
val (s [i],n,z);
if z<>0 then n:=10+ord (UpCase (s [i])) - ord ('A');
m:=m+stepen (16,length (s) - i) *n;
end;
_16to10:=m+drobch;
end;
{####### Функция _16to10 закончилась #####}
{####### Функция замены символа ##########}
function Convd (x: integer): char;
begin
if (x<10) then Convd:=chr (x+ord ('0'))
else
if (x<16)
then
Convd:=Chr (x-10+ord ('A'))
else
Convd:='0';
end;
{####### Функция перевода 10 в 16 начало #}
function _10to16 (N: string): string;
var
s: string;
i, num,kon: integer;
chislo, ostatok: longint;
ostatok1: real;
err: longint;
ost: string;
begin
num:=0;
{Проверяем, целое ли это число}
for i:=1 to length (N) do
if (N [i] ='. ') or (N [i] =',')
then
num:=i;
if num<>0
then
begin
ost:=copy (N,num+1,length (N) - num); {Создаем переменную с остатком}
delete (N,num,length (N) - num+1); {Выделяем целую часть}
end;
Val (N,chislo, err);
Val (ost,ostatok,err);
ostatok1:=ostatok/ (stepen (10,length (ost)));
{Переводим целую часть}
s:='';
repeat
s:=convd (chislo mod 16) +s;
chislo:=chislo div 16;
until chislo=0;
{Переводим дробную часть}
if num<>0
then
begin
s:=s+'. ';
kon:=0;
repeat
s:=s+convd (trunc (ostatok1*16));
ostatok1:=ostatok1- (trunc (ostatok1*16));
kon:=kon+1;
until (ostatok>0.00001) or (kon=5);
end;
_10to16:=s;
end;
{######## Функция перевода 10в 16 закончилась ##}
begin{Начала сомой процедуры обработки строк}
{разбиваем выражение на аргументы}
for i:=1 to length (allst) do
if ( (allst [i]='-') or (allst [i]='+') or (allst [i]='/') or (allst [i]='*')) and (i<>1) and (allst[i-1] <>' (')
then
begin
st2:=copy (allst, i+1,length (allst) - i); {Создаем переменную со 2 аргументом}
st1:=copy (allst,1, i-1);
mainzn:=allst [i];
end;
if mainzn=''
then
begin
st1:='0';
st2:='0';
WriteLn ('Введите корректное выражение');
end;
{Смотрим, небыло ли скобок у второго аргумента, и удаляем их}
for i:=1 to length (st2) do
if (st2 [i]=' (') or (st2 [i]=') ')
then
delete (st2, i,1);
{Переводим числа в 10сс и выполняем действие}
dec:='';
gotst:='';
if mainzn='-'
then
begin
str ( (_16to10 (st1)) - (_16to10 (st2)): 10: 3,dec);
{Проверяем знак результата}
for i:=1 to length (dec) do
if dec [i]='-'
then
begin
delete (dec,1, i);
gotst:='-'
end;
gotst:=gotst+_10to16 (dec)
end;
if mainzn='+'
then
begin
str ( (_16to10 (st1)) + (_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
if mainzn='*'
then
begin
str ( (_16to10 (st1)) * (_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
if mainzn='/'
then
if (_16to10 (st2) =0) or (_16to10 (st2) <0.0000001)
then
gotst:='error (на ноль делить нельзя!) '
else
begin
str ( (zn1*_16to10 (st1)) / (zn2*_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
WriteLn (allst,'=',gotst)
end;
{######## Процедура записи данных в файл #######}
Procedure resultPr (allst, gotst: string);
begin
gotst:=allst+'='+gotst;
Assign (result,'result. txt');
ReWrite (result);
Write (result,gotst);
Close (result);
WriteLn ('Данные успешно записаны в файл result. txt');
end;

Последний раз редактировалось Олесенька; 30.11.2012 в 22:50.
Олесенька вне форума Ответить с цитированием
Старый 30.11.2012, 22:18   #2
Олесенька
Пользователь
 
Регистрация: 12.11.2012
Сообщений: 12
По умолчанию

Код:
{####### Процедура считывания переменной из файла}
Procedure dataPr (var allst: string);
begin
Assign (data,'data. txt');
Reset (data);
readLn (data,allst);
Close (data);
end;
begin {Начало программы}
cl:=false;
While not (cl) do
begin
WriteLn ('****************************************************');
WriteLn ('****************************************************');
WriteLn ('****************Здравствуйте пользователь*****************');
WriteLn('Вас приветствует программа «шестнадцатеричный калькулятор»');
 
WriteLn ('****************Выберите нужный вам пункт? 
**************');
WriteLn ('****************1. Ввести выражение 
**************');
WriteLn ('**************2. Прочитать выражение из файла data. txt ********');
WriteLn ('*************** 3. Записать выражение в файл result. txt *********');
WriteLn ('*************** 4. Выход из программы *****************');
WriteLn ('**************************************************');
WriteLn ('************************************************');
WriteLn;
readLn (n);
case n of
1:
begin
WriteLn ('Введите выражение вида <аргумент1><действие><аргумент2>');
WriteLn ('Например: F2A1. C7+C1.85');
readLn (allst);
StProc (allst, gotst);
readLn;
end;
2:
begin
dataPr (allst);
StProc (allst, gotst);
end;
3: resultPr (allst, gotst);
4: cl:=true;
end;
WriteLn; WriteLn; WriteLn; WriteLn; WriteLn; WriteLn; WriteLn;
end;
end.

Последний раз редактировалось Олесенька; 30.11.2012 в 22:50.
Олесенька вне форума Ответить с цитированием
Старый 30.11.2012, 22:47   #3
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Цитата:
мой Вам совет: вообще, выкиньте Вы этих самодельных уродцев (я имею в виду Pascal ABC и Pascal ABC NET) и возьмите либо FreePascal + Lazarus, либо (лучше), если есть возможность, Delphi. и учитесь программировать с помощью настоящих средств разработки, а не этих "псевдо-паскальных" языков..
by Serge
А так же код на форуме оформляется кнопочкой с #, а то смотреть страшно..
Poma][a вне форума Ответить с цитированием
Старый 30.11.2012, 22:53   #4
Олесенька
Пользователь
 
Регистрация: 12.11.2012
Сообщений: 12
По умолчанию

на обычном паскале такая же проблема
выражения =0.
вот в док для паскаля.
Код:
Program kursach;
var
n: integer;
allst, gotst: string;
cl: boolean;
result, data: text;
Procedure StProc (allst: string; var gotst: string);
var
i, zn1, zn2: integer;
mainzn: char;
st1, st2, dec: string;
{”г*ЄжЁп Ї®«®¦ЁвҐ«м*®© б⥯Ґ*Ё зЁб«*}
function stepen (x,n: integer): longint;
var
k: longint;
i: integer;
begin
k:=1;
for i:=1 to n do k:=k*x;
stepen:=k;
end;
{”г*ЄжЁп ®ваЁж*⥫м*®© б⥯Ґ*Ё зЁб«*}
function minus_stepen (x,n: integer): real;
var
k: longint;
i: integer;
begin
k:=1;
for i:=1 to n do k:=k*x;
minus_stepen:=1/k;
end;
{”г*ЄзЁп ЇҐаҐў®¤* 16бб зЁб«* ў 10бб}
function _16to10 (s: string): real;
var
m,n: longint;
z:integer;
i,num: integer;
ost: string;
drobch,res: real;
begin
drobch:=0;
m:=0;
num:=0;
{Џа®ўҐа塞, 楫®Ґ «Ё нв® зЁб«®}
for i:=1 to length (s) do
if (s [i] ='. ') or (s [i] =',')
then
num:=i;
if num<>0
then
begin
ost:=copy (s,num+1,length (s) - num); {‘®§¤*Ґ¬ ЇҐаҐ¬Ґ**го б ®бв*вЄ®¬}
delete (s,num,length (s) - num+1); {‚뤥«пҐ¬ 楫го з*бвм}
{####### ЏҐаҐў®¤Ё¬ ¤а®Ў*го з*бвм #########}
n:=0;
for i:=1 to length (ost) do
begin
z:=0;
val (ost[i],n,z);
if z<>0 then n:=10+ord (UpCase (s [i])) - ord ('A');
drobch:=drobch+minus_stepen (16, i) *n;
end;
end;
n:=0;
{######## ЏҐаҐў®¤Ё¬ 楫го з*бвм #########}
for i:=1 to length (s) do
begin
val (s [i],n,z);
if z<>0 then n:=10+ord (UpCase (s [i])) - ord ('A');
m:=m+stepen (16,length (s) - i) *n;
end;
_16to10:=m+drobch;
end;
{####### ”г*ЄжЁп _16to10 §*Є®*зЁ«*бм #####}
{####### ”г*ЄжЁп §*¬Ґ*л бЁ¬ў®«* ##########}
function Convd (x: integer): char;
begin
if (x<10) then Convd:=chr (x+ord ('0'))
else
if (x<16)
then
Convd:=Chr (x-10+ord ('A'))
else
Convd:='0';
end;
{####### ”г*ЄжЁп ЇҐаҐў®¤* 10 ў 16 **з*«® #}
function _10to16 (N: string): string;
var
s: string;
i, num,kon: integer;
chislo, ostatok: longint;
ostatok1: real;
err: integer;
ost: string;
begin
num:=0;
{Џа®ўҐа塞, 楫®Ґ «Ё нв® зЁб«®}
for i:=1 to length (N) do
if (N [i] ='. ') or (N [i] =',')
then
num:=i;
if num<>0
then
begin
ost:=copy (N,num+1,length (N) - num); {‘®§¤*Ґ¬ ЇҐаҐ¬Ґ**го б ®бв*вЄ®¬}
delete (N,num,length (N) - num+1); {‚뤥«пҐ¬ 楫го з*бвм}
end;
Val (N,chislo, err);
Val (ost,ostatok,err);
ostatok1:=ostatok/ (stepen (10,length (ost)));
{ЏҐаҐў®¤Ё¬ 楫го з*бвм}
s:='';
repeat
s:=convd (chislo mod 16) +s;
chislo:=chislo div 16;
until chislo=0;
{ЏҐаҐў®¤Ё¬ ¤а®Ў*го з*бвм}
if num<>0
then
begin
s:=s+'. ';
kon:=0;
repeat
s:=s+convd (trunc (ostatok1*16));
ostatok1:=ostatok1- (trunc (ostatok1*16));
kon:=kon+1;
until (ostatok>0.00001) or (kon=5);
end;
_10to16:=s;
end;
{######## ”г*ЄжЁп ЇҐаҐў®¤* 10ў 16 §*Є®*зЁ«*бм ##}
begin{Ќ*з*«* ᮬ®© Їа®жҐ¤гал ®Ўа*Ў®вЄЁ бва®Є}
{а*§ЎЁў*Ґ¬ ўла*¦Ґ*ЁҐ ** *аЈг¬Ґ*вл}
for i:=1 to length (allst) do
if ( (allst [i]='-') or (allst [i]='+') or (allst [i]='/') or (allst [i]='*')) and (i<>1) and (allst[i-1] <>' (')
then
begin
st2:=copy (allst, i+1,length (allst) - i); {‘®§¤*Ґ¬ ЇҐаҐ¬Ґ**го б® 2 *аЈг¬Ґ*⮬}
st1:=copy (allst,1, i-1);
mainzn:=allst [i];
end;
if mainzn=''
then
begin
st1:='0';
st2:='0';
WriteLn ('‚ўҐ¤ЁвҐ Є®а४в*®Ґ ўла*¦Ґ*ЁҐ');
end;
{‘¬®ваЁ¬, *ҐЎл«® «Ё бЄ®Ў®Є г ўв®а®Ј® *аЈг¬Ґ*в*, Ё г¤*«пҐ¬ Ёе}
for i:=1 to length (st2) do
if (st2 [i]=' (') or (st2 [i]=') ')
then
delete (st2, i,1);
{ЏҐаҐў®¤Ё¬ зЁб«* ў 10бб Ё ўлЇ®«*塞 ¤Ґ©бвўЁҐ}
dec:='';
gotst:='';
if mainzn='-'
then
begin
str ( (_16to10 (st1)) - (_16to10 (st2)): 10: 3,dec);
{Џа®ўҐа塞 §**Є १г«мв*в*}
for i:=1 to length (dec) do
if dec [i]='-'
then
begin
delete (dec,1, i);
gotst:='-'
end;
gotst:=gotst+_10to16 (dec)
end;
if mainzn='+'
then
begin
str ( (_16to10 (st1)) + (_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
if mainzn='*'
then
begin
str ( (_16to10 (st1)) * (_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
if mainzn='/'
then
if (_16to10 (st2) =0) or (_16to10 (st2) <0.0000001)
then
gotst:='error (** *®«м ¤Ґ«Ёвм *Ґ«м§п!) '
else
begin
str ( (zn1*_16to10 (st1)) / (zn2*_16to10 (st2)): 10: 3,dec);
gotst:=gotst+_10to16 (dec)
end;
WriteLn (allst,'=',gotst)
end;
Олесенька вне форума Ответить с цитированием
Старый 30.11.2012, 22:53   #5
Олесенька
Пользователь
 
Регистрация: 12.11.2012
Сообщений: 12
По умолчанию

Код:
{######## Џа®жҐ¤га* §*ЇЁбЁ ¤***ле ў д*©« #######}
Procedure resultPr (allst, gotst: string);
begin
gotst:=allst+'='+gotst;
Assign (result,'result. txt');
ReWrite (result);
Write (result,gotst);
Close (result);
WriteLn ('„***лҐ гбЇҐи*® §*ЇЁб**л ў д*©« result. txt');
end;
{####### Џа®жҐ¤га* бзЁвлў**Ёп ЇҐаҐ¬Ґ**®© Ё§ д*©«*}
Procedure dataPr (var allst: string);
begin
Assign (data,'data. txt');
Reset (data);
readLn (data,allst);
Close (data);
end;
begin {Ќ*з*«® Їа®Ја*¬¬л}
cl:=false;
While not (cl) do
begin
WriteLn ('****************************************************');
WriteLn ('****************************************************');
WriteLn ('****************‡¤а*ўбвўг©вҐ Ї®«м§®ў*⥫м*****************');
WriteLn('‚*б ЇаЁўҐвбвўгҐв Їа®Ја*¬¬* <иҐбв**¤ж*вҐаЁз*л© Є*«мЄг«пв®а>');
 
WriteLn ('****************‚лЎҐаЁвҐ *г¦*л© ў*¬ Їг*Єв? **************');
WriteLn ('**************2. Џа®зЁв*вм ўла*¦Ґ*ЁҐ Ё§ д*©«* data. txt ********');
WriteLn ('*************** 3. ‡*ЇЁб*вм ўла*¦Ґ*ЁҐ ў д*©« result. txt *********');
WriteLn ('*************** 4. ‚л室 Ё§ Їа®Ја*¬¬л *****************');
WriteLn ('**************************************************');
WriteLn ('************************************************');
WriteLn;
readLn (n);
case n of
1:
begin
WriteLn ('‚ўҐ¤ЁвҐ ўла*¦Ґ*ЁҐ ўЁ¤* <*аЈг¬Ґ*в1><¤Ґ©бвўЁҐ><*аЈг¬Ґ*в2>');
WriteLn ('Ќ*ЇаЁ¬Ґа: F2A1. C7+C1.85');
readLn (allst);
StProc (allst, gotst);
readLn;
end;
2:
begin
dataPr (allst);
StProc (allst, gotst);
end;
3: resultPr (allst, gotst);
4: cl:=true;
end;
WriteLn; WriteLn; WriteLn; WriteLn; WriteLn; WriteLn; WriteLn;
end;
readln
end.
Олесенька вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
нужно исправить ошибку kg250493 Помощь студентам 6 25.10.2012 22:57
Нужно исправить ошибку onliner PHP 1 13.06.2012 00:49
нужно исправить ошибку Ania Lunee Помощь студентам 4 18.05.2012 01:23
нужно исправить ошибку marina_sergina Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 16.12.2010 01:07
нужно исправить ошибку TheVenny Помощь студентам 17 06.11.2008 16:26