Помогите бедному студенту

[Pixel-AQ]

Высокомерие первокурсников поубавить.
Код в студию!

 

[Kenku]

Зачем тебе эти пара строчек? юность вспомнить? ;-)

Да, может получится освежить дряблые участки памяти...

 

[pasha1667]

Программа перевода из одной системы счисления в другую(работает с 4мя системами счисления: 2ая, 8ая,10ая,16ая), т.е. вводим число, потом вводим основание этого числа и программа переводит из введенного числа в три оставшиеся.

Объяснение для тех кому не понятно))

program n;

uses crt;
const hex: array['a'..'f'] of integer 10,11,12,13,14,15);
var

a, c, c2,bin, hex1, oct : string;
b, i,e, int, result, x, y, x1, bin1, oct1,hex2 : integer;

function BinToDec(bin: string):longint;{2>10}
var
i, result : integer;
begin
result:=0;
for i:=1 to length(bin) do
begin
if not (bin in ['0','1']) then
begin
result:=0;
exit;
end;
if bin='1' then
result:= result+(1 shl (length(bin)-i));
end;
BinToDec:=result;
end;

function OctToInt(Value: string): Longint;{8>10}
var
i,x,c: Integer;
int: Integer;
begin
int := 0;
for i := 1 to Length(Value) do
begin
Val(Value,x,c);
if ( x>7 ) then
WriteLn(' error&#39
else
int := int * 8 + x;

end;
OctToInt := int;
end;



BEGIN
Write('vvedite chislo '
ReadLn(a);
Write('vvedite osnovanie dannogo chisla '
ReadLn(б);

if b=10 then
begin
bin:=a;
val(a,bin1,e);
for i:=0 to 16 do
begin
if (i=8) or (i=2) or (i=16) then
begin
while bin1>0 do begin
y:= bin1 mod (i);
bin1:= bin1 div (i);
case y of
10: c2:='a';
11: c2:='b' ;
12: c2:='c' ;
13: c2:='d' ;
14: c2:='e' ;
15: c2:='f' ;
else str(y,c2); end;
c:=c2+c;
end;
writeln('res',i,'=',c);
bin:=a;
val(a,bin1,e);
c:='';
end;
end;
end;

if b=8 then
begin
WriteLn('rezultat10= ',OctToInt(a));
bin1:=OctToInt(a);
for i:=0 to 16 do
begin
if (i=2) or (i=16) then
begin

while bin1>0 do begin
y:= bin1 mod (i);
bin1:= bin1 div (i);
case y of
10: c2:='a';
11: c2:='b';
12: c2:='c';
13: c2:='d';
14: c2:='e';
15: c2:='f';
else str(y,c2); end;
c:=c2+c;
end;
writeln('res',i,'=',c);
bin1:=OctToInt(a);
c:='';
end;
end;
end;

if b=2 then begin
WriteLn('rezultat10= ',BinToDec(a));
oct1:=BinToDec(a);


for i:=0 to 16 do
begin
if (i=8) or (i=16) then
begin
while oct1>0 do begin
y:= oct1 mod (i);
oct1:= oct1 div (i);
case y of
10: c2:='a';
11: c2:='b';
12: c2:='c';
13: c2:='d';
14: c2:='e';
15: c2:='f';
else str(y,c2); end;
c:=c2+c;
end;
writeln('res',i,'=',c);
oct1:=bintodec(a);
c:='';
end;
end;
end;


if b=16 then
begin
int:=0;
for i:=1 to length(a) do
if a<'a'then
int:=int*16+ord(a)-48
else
int:=int*16+hex[a];
writeln('rezultat 10 =',int);
x:=int;

for i:=0 to 16 do
begin
if (i=8) or (i=2) then
begin

while x>0 do begin
y:= x mod (i);
x:= x div (i);
case y of
10: c2:='a';
11: c2:='b';
12: c2:='c';
13: c2:='d';
14: c2:='e';
15: c2:='f';
else str(y,c2); end;
c:=c2+c;
end;
writeln('res',i,'=',c);
x:=int;
c:='';
end;
end;
end;
ReadLn;
END.

 

[pasha1667]

Программа написана без комментариев, если кому не понятно , пишите я объясню. И пока без проверок, т.е. если вы ведете число: 345, а основание введете 2, т.е. в двоичной системе, то ебстественно она посчитает неправильно. Но это я скоро исправлю и сделаю проверки, а потом выложу)))

 

[Kenku]

Хмм... человек который пару дней назад яростно просил помощи вдруг неожиданно пишет всю программу, и с хорошей логикой... чтож, буду думать что мне посчтастливилось стать свидетелем великого прозрения и распахнувшегося знаниям ума. хотя код какой-то не политеховский. эмоций маловато. короче гуглом попахивает. но не мне судить. современный первокурсник.. куда мне до него. кланяюсь. ухожу.

 

[Pixel-AQ]

а числа с дробной частью не считает...

 

[pasha1667]

считает только обычные числа. А на счет яростной помощи, просто надо было срочно, а pascal я изучал лет 6 назад еще в техникуме. Но так как все начали помогать мне с выбором моей профессии, а не с задачей))), пришлось практически заново изучать Pascal и писать самому)))
Да, функцию перевода из восьмеричной в десятичную я взял с гугла (так получилось), но остальное писал все сам!

Порадуйтесь за меня, осталось все это сдать))

 

[Pixel-AQ]

Ну раз сам написал, то сдать это сущий пустяк молоток )))

 

[ViRT]

У нас вон первокурсники такиеж, тока они вообще ничё делать нехотят, лабы у нас скупают. И так по моим предположениям, папочки по окончанию учобы со всех пяти курсов, будут кормить меня ещё лет двадцать))

 

[Pixel-AQ]

а мне такой бизнес обломали халявный) преподы поменялись и лабы))

 

[ViRT]

))косяк) на заказ пиши) курсач касарь, лабы по 100-150)

 

[traktor]

а мне такой бизнес обломали халявный) преподы поменялись и лабы))

а ты думал один раз все посчитал и на всю жизнь?