Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 114 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 60 ∙ повысить рейтинг >>

Botsman Статус: 6-й класс Рейтинг: 50 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 813
от 19.02.2009, 09:35

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

Вопрос № 160.427

Примногоуважаемые эксперты, помогите ПОЖАЛУЙСТА!!! Нужно написать программу вычитания чисел в 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:15 Вопрос задал: Челпанников Алексей Алексеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Boriss Здравствуйте, Челпанников Алексей Алексеевич! Наконец-то исправил усе! Торопился - времени меньше чем нет, но вроде работает правильно Но успеваю написать вариант только с положительными числами, хотя ввод отрицательных организовать несложно (хотя что такое будет -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. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 16.02.2009, 16:01 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243781 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Чуть не то, но дальше сам, потом для интереса скину. ОООООООООООООООООООООООгромное спасибо Boris, норм.

Отвечает: Зенченко Константин Николаевич Здравствуйте, Челпанников Алексей Алексеевич! Программа работающая в 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} --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 16.02.2009, 16:03 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243782 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru