Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль
Регистрация

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

Ответ
 
Опции темы
Старый 13.05.2018, 15:23   #1
vaselisa162000
Пользователь
 
Регистрация: 28.04.2018
Сообщений: 10
Репутация: 10
По умолчанию Система счислений

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

Program kursovay;
const
a:string[17]='0123456789ABCDEF-';
function StrToInt(const d:String):longint;
var
x:longint;
e:integer;
begin
val(d,x,e);
if (e<>0)
then
x:=0;
StrToInt:=x;
end;
function IntToStr(const i:longint):String;
var
x:string;
begin
Str(i,x);
IntToStr:=x;
end;
function AnyToDec(d:string; const base:byte):longint;
var
x:longint;
i,n:byte;
flag:boolean;
begin
flag:=(d[1]='-');
if (flag)
then
delete(d,1,1);
x:=0;
n:=length(d);
for i:=1 to n do
begin
dec(n);
inc(x,Round((Pos(d[i],a)-1)*exp(ln(base)*n)));
end;
if(flag)
then
x:=-x;
AnyToDec:=x;
end;
function DecToAny(nomer:longint; const base:byte):string;
var
x:string;
flag:boolean;
begin
flag:=(nomer<0);
if(flag)
then
nomer:=abs(nomer);
x:='';
repeat
x:=a[nomer mod base +1]+x;
nomer:=nomer div base;
until(nomer=0);
if(flag)
then
x:='-'+x;
DecToAny:=x;
end;
procedure FullLength(var d:string);
begin
while(length(d)<7) do
d:='0'+d;
end;
function Direct(const d:string):string;
var
x:string;
begin
x:=d;
if(d[1]='-')
then
delete(x,1,1);
FullLength(x);
if(d[1]='-')
then
x:='1'+x
else
x:='0'+x;
Direct:=x;
end;
function Reverse(const d:string; const base:byte):string;
var
x:string;
i:byte;
begin
x:=d;
if(d[1]='-')
then
delete(x,1,1);
FullLength(x);
x:='0'+x;
if(d[1]='-')
then
for i:=1 to length(x) do
x[i]:=IntToStr(base-1-StrToInt(x[i]))[1];
Reverse:=x;
end;
function Additional(const d:String; const base:byte):string;
var
x:string;
begin
x:=Reverse(d,base);
if(d[1]='-')
then
x:=DecToAny(1+AnyToDec(x,base),base);
Additional:=x;
end;
var
f:file of char;
b:text;
d,ans,nas,z:string;
m,p,numb:integer;
c:char;
x:byte;
begin
write('Нижняя грань диапазона m=');
readln(m);
repeat
write ('Верхняя грань диапазона p(>=',m,')=');
readln(p);
until(p>=m);
begin
repeat
writeln ('В каком виде необходимо записать результат?');
writeln('1.Прямое представление в десятичной системе счисления.');
writeln('2.Прямое представление в двоичной системе счисления.');
writeln('3.Дополнительное представление.');
writeln('4.Выход из программы.');
readln(x);
until(x in [1..4]);
if x=4
then
begin
writeln ('Программа завершена ');
halt;
end;
ans:=IntToStr(AnyToDec(d,16));
nas:=DecToAny(AnyToDec(d,16),2);
case x of
1:z:=direct(ans);
2:z:=direct(nas);
3:begin
z:=Additional(nas,2);
if d[1]<>'-' then
z:=d;
end;
end;
assign(f,'f.txt');
assign(b,'b.txt');
ReSet(f);
rewrite(b);
d:='';
while not (eof(f)) do
begin
read(f,c);
if(Pos(c,a)>0)
then
begin
if((c='-')and(length(d)=0))or(c<>'-')
then
d:=d+c;
end
else
if(c='.')
then
begin
WRITELN('Ошибка! Некорректный символ.');
close(f);
halt;
end
ELSE
if(c=',')
then
begin
numb:=anytodec(d,16);
if (numb>=m)and(numb<=p)
then
begin
writeln(d,'=',z);
write(b,d);
write(b,'=');
write(b,z);
write(b,' ');
end;
d:='';
end;
ans:=IntToStr(AnyToDec(d,16));
nas:=DecToAny(AnyToDec(d,16),2);
case x of
1:z:=direct(ans);
2:z:=direct(nas);
3:begin
z:=Additional(nas,2);
if d[1]<>'-'
then
z:=d;
end;
end;
end;
close(f);
close(b);
ans:=IntToStr(AnyToDec(d,16));
nas:=DecToAny(AnyToDec(d,16),2);
case x of
1:z:=direct(ans);
2:z:=direct(nas);
3:begin
z:=Additional(nas,2);
if d[1]<>'-'
then
z:=d;
end;
end;
end;
readln;
end.

Исходный файл:
f.txt

Последний раз редактировалось Аватар; 13.05.2018 в 17:51.
vaselisa162000 вне форума   Ответить с цитированием
Старый 15.05.2018, 22:24   #2
digitalis
Профессионал
 
Аватар для digitalis
 
Регистрация: 04.02.2011
Адрес: Минск
Сообщений: 1,030
Репутация: 392
По умолчанию

Во-первых, текст исходника надо форматировать, так читать его - глаза повылезают.
Во-вторых - а запускать прогу на этом тестовом файлике - пробовали? Написать (сдуть где-нибудь) прогу - это еще пол-дела, дальше идет тестирование - отладка - тестирование ... - и так до получения правильной работы. И если выявится неубиваемый баг - тогда всем миром его помогут придушить. А вот "почитайте, найдите мои ошибки" - это скучно.
А 16-ричное число со знаком - честно говоря, первый раз вижу.

Последний раз редактировалось digitalis; 15.05.2018 в 23:09.
digitalis вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Системы счислений ilgar4ik Помощь студентам 3 06.09.2012 20:05
системы счислений kora8804 Помощь студентам 1 18.03.2012 16:32
системы счислений kora8804 Помощь студентам 1 18.03.2012 14:57
Системы счислений(паскаль) Вирис Помощь студентам 1 30.03.2010 15:15
Системы счислений. Паскаль Fifo4ka Помощь студентам 5 20.10.2009 00:48


18:26.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru