Помощь - Поиск - Пользователи - Календарь
Полная версия: перевод из 2-ичной в 16-ичную с.с.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
MiX
Вообщем нужна перевести из 2 в 16 с.с. из Double Word-a в Double Word.
Я вот силами несилами вот такое склеил, но она недоконца работает. Мне препод говорит что бя ввел тридцать две единицы а она непашет правильно. Помогите пожалуста, может ее можно както упростить.

Код
uses crt;
var s:string;
b,c,d,h,i,t:longint;   a:word;
n:array [1..255] of longint;
f:Boolean;
begin
  clrscr;
  writeln('vvetite chislo v formate DOUBLE WORD ');
  readln(s);
  if length(s) > 32  then
  writeln('4islo bolwe Double word')
  else
  f:=true;
  for i:=1 to length(s) do
    if (s[i]<>'1') and (s[i]<>'0') then
    begin
      clrscr;
      writeln('ERROR');
     f:=false;
     readkey;
  end;
  if f then begin
  a:=0; b:=1;
  for i:=length(s) downto 1 do
    begin
      a:=a+((ord(s[i]))-ord('0'))*b;
      b:=b*2;
    end;
   writeln('desyatkove chislo  ',a);
   write('16 chislo- ');
   if (a<=9) and (a>=1) then writeln(a) else
      case a of
      10:write('A');
      11:write('B');
      12:write('C');
      13:write('D');
      14:write('E');
      15:write('F');
      end;
   while a>=16 do
   begin
     d:=a div 16;
     h:=a mod 16;
     n[i]:=h;
     i:=i+1;
     if d<16 then
     begin
       n[i]:=d;
       i:=i+1;
       a:=d;
     end
     else
       a:=d;
        end;
        for i:=i-1 downto 1 do
        begin
          a:=n[i];
          if (a>=0)and(a<=9) then
          write(a)
          else
            begin
              case a of
              10:write('A');
              11:write('B');
              12:write('C');
              13:write('D');
              14:write('E');
              15:write('F');
             end
             end;
end;
writeln;
readln;
end;
end.
volvo
Цитата
может ее можно както упростить.

Можно попробовать:

uses crt;
var
s, st, _result: string;
i: integer;

const
hexs: array[0 .. $F] of char = (
'0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
);
bins: array[0 .. $F] of string[4] = (
'0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111',
'1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'
);
begin
clrscr;
writeln('vvetite chislo v formate DOUBLE WORD ');
readln(s);
if length(s) > 32 then writeln('4islo bolwe Double word')
else begin
_result := '';
repeat

if length(s) < 4 then
while length(s) < 4 do begin
s := '0' + s;
writeln(s);
end;

st := copy(s, length(s) - 3, 4);
delete(s, length(s) - 3, 4);

for i := 0 to $f do
if bins[i] = st then _result := hexs[i] + _result;

until s = '';
end;
writeln(_result);
readln;
end.
Айра
Эх, volvo, опередил, а я так старалась smile.gif)

Один момент:
а вот тут разве не должно быть наоборот:
   if length(s) < 4 then
while length(s) < 4 do begin
s := '0' + s; \\s:=s+'0';
writeln(s);
end;

по-моему нули дописываются в конец числа..
volvo
Цитата
по-моему нули дописываются в конец числа
То есть, ты хочешь сказать, что '11' не должно переводиться, как '0011', а должно - как '1100'? smile.gif
Айра
wink.gif это если число дробное.. мы же с целыми работаем.. сорри.. unsure.gif
MiX
Спасибо за помощь, вы ме очень помогли good.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.