VPF::[Pascal] перевод из 10чной в 2 чную - Форум программистов

nesty

Дата 17.2.2008, 19:23 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 17.2.2008

Репутация: нет
Всего: нет

SOS...срочно нужна помощь...программа по переводу из двоичной системы в десятичную и обратно переводит неправильно четные числа из десятичной(((...незнаю что делать...помогите пожалуйста
вот код

Код


uses crt;
var
nom: integer;

procedure zadanie1;

var
bin:string[8];
das:array[1..32] of string;
dec,m:longint;
v,mind,k,s,w,h,j:integer;
i:integer;
mas,kas:array[1..32] of integer;
begin
writeln('ЏаҐ®Ўа §®ў ЁҐ ¤ҐбпвЁз®Ј® зЁб«  ў ¤ў®Ёз®Ґ');
readln (dec);
h:=0;
begin
if dec>0 then
 begin
   m:=dec;
     while dec>0 do
       begin
         h:=h+1;
         w:=dec mod 2;
         dec:=dec div 2;
          if w>0 then
            begin
              mas[h]:=1;
            end
          else
            begin
              mas[h]:=0;
            end;
       end;
   if (m<255) then
     begin
       j:=8-h;
     end;
   if (m>255) and (m<65535)  then
     begin
       j:=16-h;
     end;
   if (m>65535) and (m<2147483647)  then
     begin
       j:=32-h;
     end;
         for v:=1 to j do
           begin
             das[v]:='0';
             write(das[v]);
           end;
         for v:=h downto 1 do
           begin
             write (mas[v]);
           end;
         readln;
      end;
end;
begin
if dec<0 then
  begin

 dec:=abs(dec);
 m:=dec;
 while dec>0 do
  begin
  h:=h+1;
  w:=dec mod 2;
  dec:=dec div 2;
  if w>0 then
  begin
  mas[h]:=0;

  end
  else
  begin
  mas[h]:=1;

  end;

  end;

 if (m<255) then
 begin
 j:=8-h;
 end;

 if (m>255) and (m<65535)  then
 begin
 j:=16-h;
 end;

 if (m>65535) and (m<2147483647)  then
 begin
 j:=32-h;
 end;




s:=mas[h];
if mas[1]=1 then
begin
 for k:=h+1 to 2 do
 begin
  kas[k]:=mas[k-1];
 end;

 for v:=1 to j do
  begin
  write('1');
 end;

 for v:=h-1 downto 1 do
 begin
 write (mas[v]);
 end;

write('0');
end

else
begin
 for v:=1 to j do
  begin
  write('1');
 end;
 mas[1]:=1;
 for v:=h downto 1 do
 begin
 write (mas[v]);
 end;

end;

readln;

end;
end;
end;


procedure zadanie2;
VAR
bin:string;
dec, otv1, otv2:integer;
r:string[1];
v:integer;
m,i,n,t,z,w,k,o,p,x,j,g:integer;
begin
  writeln('‚ўҐ¤ЁвҐ ¤ў®Ёз®Ґ зЁб«®');
  readln(bin);

    if bin[1]='1' then
      begin
        m:=2;
      end
    else
      begin
        m:=1;
      end;
  dec:=0;
  v:=128;
  n:=length(bin);
  w:=2;
    for i:=1 to n do
      begin
        w:=2;
        r:=bin[i];
          if r='1' then
            begin
              t:=1;
            end
          else
            begin
              t:=0;
            end;
        p:=n-i;
          if (p=0) then
            begin
              w:=1;
            end
          else
            begin
              w:=1;
                for k:=1 to p do
                  begin
                    w:=w*2;
                  end;
            end;
        z:=t*w;
        dec:=dec+z;
      end;
    otv1:=dec;
    {writeln(dec);}
    p:=0;
    dec:=0;
    w:=0;

      if bin[n]='1' then
        begin
          bin[n]:='0';
        end;
      for i:=1 to n do
        begin
          w:=2;
          r:=bin[i];
            if r='1' then
              begin
                t:=0;
              end
            else
              begin
                t:=1;
              end;
          p:=n-i;
            if (p=0) then
              begin
                w:=1;
              end
            else
              begin
                w:=1;
                  for k:=1 to p do
                    begin
                      w:=w*2;
                    end;
              end;
          z:=t*w;
          dec:=dec+z;
        end;
      otv2:=dec*(-1);
      {writeln('-',dec);}
      if otv1<>otv2 then
        begin
          writeln(otv1);
          writeln(otv2);
        end
      else
        begin
          writeln(otv1);
        end;
      readln;
end;


begin

clrscr;
writeln('“Є ¦ЁвҐ ®¬Ґа § ¤ Ёп:');
readln(nom);
         case nom of

             1:  zadanie1;

                 2:  zadanie2;

             else  writeln('’ Є®Ј® § ¤ Ёп Ґв');

          end;


     end.

всем заранее спасиба....

orthrus

Дата 18.2.2008, 05:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 400
Регистрация: 30.10.2007
Где: г. Усть-Илимск(Ир кутская обл.)

Репутация: 5
Всего: 16

вот так сделай а то у тебя код какой то длинный smile

Код



FUNCTION DecToBin(i:integer):string;
VAR
   out_str:string;
BEGIN
     out_str := '';
     while (i>0) do
     begin
          if (i and $1)=1 then insert('1',out_str,1)
                          else insert('0',out_str,1);
          i := i shr 1;
     end;
     while ((sizeof(integer)*8)>length(out_str)) do
           insert('0',out_str,1);
     DecToBin := out_str;
END;

FUNCTION BinToDec(bin:string):integer;
VAR
   i:integer;
BEGIN
     i := 0;
     while (length(bin)>0) do
     begin
          if (bin[1] = '1') then
                            begin
                                 i := i shl 1;
                                 inc(i);
                            end
                            else i := i shl 1;
          delete(bin,1,1);
     end;
     BinToDec := i;
END;

BEGIN
  writeln(DecToBin(10));
  Writeln(BinToDec(DecToBin(10)));
  readln;
END.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »