Консультация № 160427
14.02.2009, 09:15
60.00 руб.
0 8 2
Примногоуважаемые эксперты, помогите ПОЖАЛУЙСТА!!! Нужно написать программу вычитания чисел в 16-ричной системе счисления под Паскаль ABC. Использование оператора GOTO не допускается. Оформить в виде ПОДПРОГРАМ... Предидущий ответ не подходит не по виду, не по построению.

Program aaa;

type....

var....

procedure (var...; .....);

begin....

И так далее. ЗАРАНЕЕ СПАСИБО,
исполненный таки надеждой, Алексей.



Приложение:
uses CRT;

function InputBinary: String;
var buf: String; ch: char;
x, y: Integer;
begin
Write('Введите бинарную строку: ');
x := WhereX; y:=WhereY;
buf := '';
repeat
gotoxy(x + length(buf), y);
ch := ReadKey;
case ch of
'0','1': buf := buf + ch;
#8: {backspace} if length(buf) >= 1 then delete(buf, length(buf), 1);
end;
gotoXY(x, y); write(buf,' ')
until (ch = #13) or (ch = #27) or (length(buf) >= 16); {ENTER или Esc}
WriteLn;
if buf = '' then buf := '0';
InputBinary := buf
end;

function Convert(num: String): Integer;
var i, n, dig: Integer;
begin
n := 0;
dig := 1;
while length(num) < 16 do num := '0' + num;
for i:= length(num) downto 1 do
begin
n := n + (ord(num[i])-48)*dig;
dig := dig * 2;
end;
Convert := n
end;


VAR
num1, num2: String;
k, m: Integer;
BEGIN

num1 := InputBinary;
num2 := InputBinary;

{доводим длину до стандартной 16}
writeLn(num1,' ',num2);
while length(num1) < 16 do num1 := '0' + num1;
while length(num2) < 16 do num2 := '0' + num2;
WriteLn('десятичная запись: ',Convert(num1),' - ', Convert(num2));
WriteLn(num1,#10#13,'-',#10#13,num2,#10#13,'-------------');

{вычитание. Пишу как можно проще, то-есть, реализую пошагово действия ручные}
for k := 16 downto 1 do
case num1[k] of
'0': if num2[k] = '1' then
begin
num1[k] := '1';
m := k -1;
while (m >= 1) do begin
if num1[m] = '1' then
begin num1[m] := '0'; break end
else num1[m] := '1';
dec(m)
end
end;
'1': if num2[k] = '1' then num1[k] := '0';
end;

WriteLn(num1);
WriteLn(' Результат в десятичной форме: ', convert(num1));
END.

Обсуждение

Неизвестный
14.02.2009, 09:58
общий
Ответ тоже в 16 СС. И еще, поясните пожалуйста что это за выражения в предыдущей программе: WhereY и ch = #13.
Неизвестный
14.02.2009, 12:19
общий
WhereY - это функция из модуля CRT нормального Паскаля. Определяет номер строки, где находится курсор
ch = #13; - каждый символ имеет свой код. Знак "решетка" = # значит в Паскале "символ с кодом 13". Это код клавиши ENTER.
То есть, если нажата клавиша ENTER, то ввод прекращается
Такой код был использован, чтобы была программная возможность коррекции ввода
И еще в минифоруме я давал вариант это функции, где это не используется
Можно предложить еще несколько вариантов правильности ввода.
И ЕЩЕ!!! В PascalABC?
Неизвестный
14.02.2009, 13:45
общий
Да. Смысл в том, что как вы говорите "в нормальном" паскале много всего того, что мы просто не изучали.
Неизвестный
14.02.2009, 14:07
общий
Нет проблем - пишу в ём. Но отрывают постоянно ...
ЗЫ: если не секрет, то где в этом Паскале учат? Я смотрю, это самодельная российская .... изделие
Неизвестный
14.02.2009, 14:20
общий
Да нет, в общем, смысл как раз в том что он понимает, turbo включает в себя уйму того, чего мы не знаем((((
Неизвестный
15.02.2009, 01:49
общий
Ау, ужо горит Оооочень....
Неизвестный
16.02.2009, 16:01
общий
это ответ
Здравствуйте, Челпанников Алексей Алексеевич!
Наконец-то исправил усе! Торопился - времени меньше чем нет, но вроде работает правильно
Но успеваю написать вариант только с положительными числами, хотя ввод отрицательных организовать несложно (хотя что такое будет -FFFF?)

Приложение:

{Допустимые символы}
const Allowed: set of CHAR = ['0'..'9','+','A'..'F','a'..'f']; { Допустимые для ввода символы}
NoChars: set of char = ['n','N',#27, 'т', 'Т'];
{Символы отказа от повтора ввода: esc и кнопка N, она же Т (при руссской
раскладе)}

procedure InputHEX(var dst: String);
var i: Integer;
Done: Boolean;
begin
repeat
Write('Введите шестнадцатиричное число: ');
ReadLn(dst);
{Проверка}
Done:=True;
i := PosEx('-', dst, 2);
if ( i = 0) then i := PosEx('+', dst, 2);
if i <> 0 then begin
WriteLn('Встретился символ "',dst[i],'" внутри числа. Это недопустимо');
WriteLn('Хотите ввести число заново (если N=нет, то результат будет ''0'')? (Y/N)');
Readln(dst);
if dst[1] in NoChars then begin dst:='0'; Done := True end
else Done := False;
end
else
for i:= 1 to length(dst) do
if NOT (dst[i] in Allowed) then
begin
WriteLn('Имеются недопустимые символы "',dst[i],'" в позиции ',i);
WriteLn('Хотите ввести число заново (если N=нет, то результат будет ''0'')? (Y/N)');
Readln(dst);
if dst[1] in NoChars then begin dst:='0'; Done := True; Break end
else Done := False;
end
until Done;
end;

procedure SubHEX(src1, src2: String; var dst: String;
min_len_of_number : Integer := 4);
{Без применения перевода в числа. Следовательно, могут быть большими
Последний параметр = параметр по умолчнию, если не задан при
вызове, то будет больше (если одна из строк=чисел длинее) и равен 4}
const symbols: String = '0123456789ABCDEF';

{локальная функция преобзразования символа=цифры в число}
function ToNum(c: char): Integer;
begin
Result := ord(c) - 48;
if c > '9' then Result -= 7;
end;

var i, k, num1, num2, zaem:Integer;
begin
{Выравниваем длину строк. Сначала, если первая длинее второй, а потом, если
вторая длинее первой}
while length(src1) < length(src2) do
src1 := '0' + src1;
while length(src2) < length(src1) do
src2 := '0' + src2;
{Подгоняем длину строк под минимальную}
while length(src1) < min_len_of_number do begin
src1 := '0' + src1; src2 := '0' + src2;
end;
dst := src1; for i:= 1 to length(dst) do dst[i] := '0'; {заготовка результата}
{Для простоты работы преобразуем все символы в заглавные}
for i:=1 to length(src1) do begin
src1[i] := UpCase(src1[i]);
src2[i] := UpCase(src2[i]);
end;
{Собственно, вычитание}
i:= length(src1);
while i > 0 do begin
num1 := ToNum(src1[i]);
num2 := ToNum(src2[i]);
if num1 >= num2 then dst[i] := symbols[num1 - num2 + 1]
else begin
k:=i-1; zaem := 0;
dst[i] := symbols[ 17 + num1 - num2];
zaem := 1;
while (k > 0) and (zaem <> 0) do begin
num1 := ToNum(src1[k]); num2 := ToNum(src2[k]);
if num1 < num2 then begin
src1[k]:= symbols[ 17 + num1 - num2];
zaem := 1 end
else begin
src1[k] := symbols[num1 - num2 - zaem + 1];
zaem := 0;
end;
dec(k);
end;
end;
dec(i);
end;
end;

var
s1, s2, s3: String;
BEGIN
InputHex(s1);
InputHex(s2);
SubHex(s1, s2, s3);
WriteLn('Разность: ',s3);
END.
давно
Старший Модератор
31795
6196
16.02.2009, 16:03
общий
это ответ
Здравствуйте, Челпанников Алексей Алексеевич!

Программа работающая в 16-ой СС(ввод-вывод), в приложении(под pascalABC).
По функциям:
HexToBin рекурсивная функция преобразовывающая число в 16-ой системе в двоичную запись.
inputHex подпрограмма вводит число в 16-ой системе и возвращающая число в двоичной, запись двоичного числа производится в обратном порядке, с помощью этого достигается выравнивание чисел, т.е. разряды с одинаковым весом имеют одинаковые позиции в строке.
outputHex рекурсивная процедура выводит число в 16-ой системе. При рекурсии каждый раз обрабатывается одна 16-я цифра.
doSummaBin процедура суммирования двух двоичных чисел.
rangeBin процедура выравнивает введенные числа на размер определенный в разделе констант.
convertBin процедура перевода двоичного числа в дополнительный код.
Рабочие числа в программе - двоичные, а ввод и вывод производится в 16-ой системе(сокращенная запись двоичных чисел), практически как и в самом процессоре.

Удачи!

Приложение:
uses crt;
const
n=32;
type
TMass=string[n];
var a,b,c:TMass;
function HexToBin(d,e:integer):string;
begin
{корректируем под 16-е число}
{ dec(d,7*ord(d>9));}
if d>9 then dec(d,7);
HexToBin:='';
{рекурсивно формируем 16-е число ввиде строки}
if e>0 then HexToBin:=chr(ord('0') + d mod 2) + HexToBin(d div 2,e-1);
end;
procedure inputHex(var d:TMass;e:char);
begin{inputHex}
{вводим число в обратном порядке}
write('Enter number',e:2,':');
d:='';
repeat
e:=ReadKey;{символ без эхо}
case e of
'0'..'9','A'..'F','a'..'f':
begin
{ e:=chr(ord(e) - 32*ord(e>'Z'));{приводим число к единому регистру}
if e>'Z'then e:=chr(ord(e) - 32);
write(e);{выводим его}
d:=HexToBin(ord(e)-ord('0'),4)+d;{формируем двоичную строку}
end;
end;{case}
until (e=chr(13))or(length(d)=n);{}
writeln;
end;{inputHex}
procedure outputHex(d:TMass);
var
i,j:integer;
e:TMass;
begin{outputHex}
if length(d)>0 then
begin{if}
e:=copy(d,1,4);{получаем четыре бита}
{ delete(d,1,4);{удаляем их их числа}
outputHex(copy(d,5,length(d)-4));{рекурсивно вызываем себя}
i:=0;
j:=length(e);
while j>0 do{преобразовываем строку в число}
begin{while}
i:=i*2 + ord(e[j]) - ord('0');
dec(j);
end;{while}
if i>9 then inc(i,7);{*ord(i>9));{корректируем его с учетом 16-ой системы}
e:=chr(ord('0')+i);{формируем символ и выводим его}
write(e);
end;{if}
end;{outputHex}
procedure doSummaBin(var d,e:Tmass);
var
f:char;
i:integer;
begin{doSummaBin}
f:='0';{флаг переноса для старшего разряда}
for i:=1 to length(d) do
begin{for}
if (e[i]<>d[i])then
{обрабатываем ситуацию когда биты различны}
begin{ed=10,01}
if f='1'
then d[i]:='0' {edf=101,011}
else d[i]:='1';{edf=100,010}
end{10,01}
else
{обрабатываем ситуацию когда биты одинаковы}
begin{ed=00,11}
{edf=001,000,111,110}
d[i]:=f;
f:=e[i];
end;{00,11}
end;{for}
end;{doSummaBin}
procedure rangeBin(var d:Tmass);
begin{rangeBin}
while length(d)<n do
d:=d+'0';{}
end;{rangeBin}
procedure convertBin(var d:TMass;e:TMass);
var
i:integer;
begin{convertBin}
for i:=1 to length(d)do
{инвертируем биты}
case d[i]of{case}
'0':d[i]:='1';
'1':d[i]:='0';
end;{case}
rangeBin(e);{выравниваем строку}
doSummaBin(d,e);{суммируем}
end;{convertBin}
begin{main}
{вводим числа}
inputHex(a,'A');
inputHex(b,'B');
{выравниваем к одному размеру}
rangeBin(a);
rangeBin(b);
{переводим в дополнительный код}
convertBin(b,'1');
{суммируем А + Вд}
doSummaBin(a,b);
{выводим результат}
outputHex(a);
ReadKey;
end.{main}
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа