Перевод числа из десятичной системы счисления в заданную пользователем систему

22.06.2014, 15:10. **Показов** 3248. **Ответов** 2

Author24 — интернет-сервис помощи студентам

Надо написать программу на Delphi чтобы она могла переводить числа из десятичной системы счисления в заданную пользователем систему. Сдаю экзамен дали задание, а в делфи я не очень силен. Знаю только паскаль на базовом уровне. Помогите прошу люди добрые.

Добавлено через 1 минуту
P.S Искал на форуме и на гугле, но не нашел рабочую программу. P.S.S Использую Delphi XE5

@Puporev · 22.06.2014, 16:22

В СС 2_16, мало, добавь. Написано в Делфи 7.

Delphi

const digit:string[16]='0123456789ABCDEF'; //цифры в СС от 2 до 16
//Функция перевода Dec числа в любую сс
//n-число в сс 10, r-система счисления в которую переводим
function FromDec(n,r:integer):string;
begin
result:='';
repeat
result:=digit[(n mod r)+1]+result;
n:=n div r;
until n=0;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
with ComboBox1 do
 begin
  text:='В какую систему перевести';
  for i:=2 to 16 do
  items.Add(inttostr(i))
 end; 
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var n,p,c:integer;
begin
val(ComboBox1.Text,p,c);
if c<>0 then
 begin
  ShowMessage('Не выбрана систеиа счисления');
  exit
 end;
val(Edit1.Text,n,c);
if (c<>0)or(n<0) then
 begin
  ShowMessage('Неверно введено число');
  Edit1.Clear;
  Edit1.SetFocus;
  exit
 end;
Edit2.Text:=FromDec(n,p)
end;

@MrPro100Viper · 22.06.2014, 18:17

Вот, только она на паскале.

Pascal

program convertor;
uses crt;
function GetDecFromHex(hex:char) : string;
  begin
    case hex of
      'A' : GetDecFromHex:= '10'; 
      'a' : GetDecFromHex:= '10'; 
      'B' : GetDecFromHex:= '11'; 
      'b' : GetDecFromHex:= '11'; 
      'C' : GetDecFromHex:= '12'; 
      'c' : GetDecFromHex:= '12';
      'D' : GetDecFromHex:= '13'; 
      'd' : GetDecFromHex:= '13'; 
      'E' : GetDecFromHex:= '14'; 
      'e' : GetDecFromHex:= '14'; 
      'F' : GetDecFromHex:= '15'; 
      'f' : GetDecFromHex:= '15'; 
      else
        GetDecFromHex:= hex;
    end;
  end;
function GetHexFromDec(hex:integer) : string;
  begin
    case hex of
      10 : GetHexFromDec:= 'A'; 
      11 : GetHexFromDec:= 'B'; 
      12 : GetHexFromDec:= 'C'; 
      13 : GetHexFromDec:= 'D'; 
      14 : GetHexFromDec:= 'E'; 
      15 : GetHexFromDec:= 'F'; 
      else
        GetHexFromDec:= IntToStr(hex);
    end;
  end;
 
function dec2bin(dec:integer):string;
  var return: string;
  begin
    while dec <> 0 do
      begin
        return:= return + IntToStr(dec mod 2);
        dec:= dec div 2;
      end;
      
      dec2bin:= ReverseString(return);
  end;
  
function dec2oct(dec:integer):string;
  var return: string;
  begin
    while dec <> 0 do
      begin
        return:= return + IntToStr(dec mod 8);
        dec:= dec div 8;
      end;
      
      dec2oct:= ReverseString(return);
  end;
  
function dec2hex(dec:integer):string;
  var return: string;
  begin
    while dec <> 0 do
      begin
        return:= return + GetHexFromDec(dec mod 16);
        dec:= dec div 16;
      end;
      
      dec2hex:= ReverseString(return);
  end;
  
  
  
function bin2dec(bin:string) :string;
  var return: integer; i: integer;
  begin
    for i:=1 to length(bin) do
      begin
          return:= return + (strtoint(bin[i]) * round(power(2,length(bin) - i + 1)));
      end;
      bin2dec:= IntToStr(return div 2);
  end;
  
function bin2oct(bin:string):string;
  var return :string; i:integer;
  begin
    if length(bin) mod 3 <> 0 then
      for i:= 0 to abs((length(bin) mod 3)- 2) do
        bin:= '0'+bin;
    i:= 1;
    while i < length(bin) do
      begin
        return:= return + (bin2dec(bin[i]+bin[i+1]+bin[i+2]));
       
        i:= i + 3;
      end;
    bin2oct:= return;
  end;
  
function bin2hex(bin:string):string;
  var return :string; i:integer;
  begin
    if length(bin) mod 4 <> 0 then
      for i:= 0 to abs((length(bin) mod 4)- 3) do
        bin:= '0'+bin;
        
    i:= 1;
    while i < length(bin) do
      begin
        return:= return + GetHexFromDec(StrToInt(bin2dec(bin[i]+bin[i+1]+bin[i+2]+bin[i+3])));
       
        i:= i + 4;
      end;
    bin2hex:= return;
  end;
  
  
  
function oct2dec(oct:string):string;
  var return: integer; i: integer;
  begin
    for i:=1 to length(oct) do
      begin
          return:= return + (strtoint(oct[i]) * round(power(8,length(oct) - i + 1)));
      end;
      oct2dec:= inttostr(return div 8);
  end;
  
function oct2bin(oct:string):string;
  var buff,return:string; i,j:integer;
  begin
    for i:= 1 to length(oct) do
      begin
        buff:= dec2bin(StrToInt(oct[i]));
          
        if length(buff) mod 3 <> 0 then
          for j:= 0 to abs((length(buff) mod 3)- 2) do
            buff:= '0'+buff;
              
        return:= return + buff;
      end;
      oct2bin:= return;
  end;
  
function oct2hex(oct:string):string;
  begin
    oct2hex:= bin2hex(oct2bin(oct));
  end;
  
  
  
function hex2dec(hex:string):string;
  var return: integer; i: integer;
  begin
    for i:=1 to length(hex) do
      begin
          return:= return + (strtoint(GetDecFromHex(hex[i])) * round(power(16,length(hex) - i + 1)));
      end;
      hex2dec:= inttostr(return div 16);
  end;
  
function hex2bin(hex:string):string;
  var buff,return:string; i,j:integer;
  begin
    for i:= 1 to length(hex) do
      begin
        buff:= dec2bin(StrToInt(GetDecFromHex(hex[i])));
          
        if length(buff) mod 4 <> 0 then
          for j:= 0 to abs((length(buff) mod 4)- 3) do
            buff:= '0'+buff;
              
        return:= return + buff;
      end;
      hex2bin:= return;
  end;
  
function hex2oct(hex:string):string;
  begin
    hex2oct:= bin2oct(hex2bin(hex));
  end;
  
  
 
label restart,wrong; 
var key: integer; buff,buff2: string; fkey: char;
begin
  writeln('                                     Задача "Рiвнобедренi трикутники на площинi"');
  writeln('                                                                 Роботу виконав:');
  writeln('                                                             студент групи ПК-22');
  writeln('                                                                Гусак Тарас');
  writeln('                                  Умова задачi:');
  writeln('Дано множину N рiзних точок на площинi. Знайти усi рiвнобедренi трикутники,     вершини яких належать N. З цих трикутникiв знайти трикутники з найбiльшою       висотою, що проведена до основи.');
  writeln();
  writeln('                     ДЛЯ ПРОДОВЖЕННЯ НАТИСНIТЬ КЛАВIШУ ENTER');
  readln();
  
  restart:
    clrscr;  
    
    writeln('Виберiть системи числення');
    
    writeln('1 - З двiйкової в вiсiмкову');
    writeln('2 - З двiйкової в десяткову');
    writeln('3 - З двiйкової в шiстнадцяткову');
    writeln('4 - З вiсiмкової в двiйкову');
    writeln('5 - З вiсiмкової в десяткову');
    writeln('6 - З вiсiмкової в шiстнадцяткову');
    writeln('7 - З десяткової в двiйкову');
    writeln('8 - З десяткової в вiсiмкову');
    writeln('9 - З десяткової в шiстнадцяткову');
    writeln('10 - З шiстнадцяткової в двiйкову');
    writeln('11 - З шiстнадцяткової в вiсiмкову');
    writeln('12 - З шiстнадцяткової в десяткову');
    writeln('');
    writeln('Зробiть Ваш вибiр, обравши один з пунктiв меню та ввiвши його номер.');
    writeln('Пiсля завершення вибору натиснiть клавiшу ENTER');
    writeln('');
    writeln('');
    writeln('0 - Вийти з програми');
    
    readln(key);
    
    clrscr;
    
    case key of
      0 : exit;
      1 : 
        begin
          writeln('Введiть даннi у двiйковому форматi');
          readln(buff);
          buff2:= bin2oct(buff);
        end;
      2 : 
        begin
          writeln('Введiть даннi у двiйковому форматi');
          readln(buff);
          buff2:= bin2dec(buff);
        end;
      3 : 
        begin
          writeln('Введiть даннi у двiйковому форматi');
          readln(buff);
          buff2:= bin2hex(buff);
        end;
      4 : 
        begin
          writeln('Введiть даннi у вiсiмковому форматi');
          readln(buff);
          buff2:= oct2bin(buff);
        end;
      5 : 
        begin
          writeln('Введiть даннi у вiсiмковому форматi');
          readln(buff);
          buff2:= oct2dec(buff);
        end;
      6 : 
        begin
          writeln('Введiть даннi у вiсiмковому форматi');
          readln(buff);
          buff2:= oct2hex(buff);
        end;
      7 : 
        begin
          writeln('Введiть даннi у десятковому форматi');
          readln(buff);
          buff2:= dec2bin(StrToInt(buff));
        end;
      8 : 
        begin
          writeln('Введiть даннi у десятковому форматi');
          readln(buff);
          buff2:= dec2oct(StrToInt(buff));
        end;
      9 : 
        begin
          writeln('Введiть даннi у десятковому форматi');
          readln(buff);
          buff2:= dec2hex(StrToInt(buff));
        end;
      10 : 
        begin
          writeln('Введiть даннi у шiстнадцятковому форматi');
          readln(buff);
          buff2:= hex2bin(buff);
        end;
      11 : 
        begin
          writeln('Введiть даннi у шiстнадцятковому форматi');
          readln(buff);
          buff2:= hex2oct(buff);
        end;
      12 : 
        begin
          writeln('Введiть даннi у шiстнадцятковому форматi');
          readln(buff);
          buff2:= hex2dec(buff);
        end;
      else
        goto restart;
    end;
    
    wrong:
      clrscr;
      
      writeln('Ви ввели: ');
      writeln(buff);
      writeln('Результат: ');
      writeln(buff2);
      writeln('');
      writeln('1 - Повернутись у меню вибору');
      writeln('0 - Вийти з програми');
      
      fkey:= ReadKey;
      
      if fkey = '0' then
        exit;
      if fkey = '1' then
        begin
          buff:= '';
          buff2:= '';
          goto restart;
        end
      else
        goto wrong;
    
end.

перепиши под себя.

Добавлено через 34 секунды
Забыл добавить, переводит она из любой системы в любую.

Fr1d4er
		1
	Перевод числа из десятичной системы счисления в заданную пользователем систему 22.06.2014, 15:10. Показов 3248. Ответов 2 Метки нет (Все метки) Надо написать программу на Delphi чтобы она могла переводить числа из десятичной системы счисления в заданную пользователем систему. Сдаю экзамен дали задание, а в делфи я не очень силен. Знаю только паскаль на базовом уровне. Помогите прошу люди добрые. Добавлено через 1 минуту P.S Искал на форуме и на гугле, но не нашел рабочую программу. P.S.S Использую Delphi XE5

	22.06.2014, 18:17

Перевод числа из десятичной системы счисления в заданную пользователем систему

Решение