С Новым годом! Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
1 из 3 1 23 »
 
Рейтинг 4.65/775: Рейтинг темы: голосов - 775, средняя оценка - 4.65
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876

Перевод в различные системы счисления

06.02.2011, 22:42. Показов 151036. Ответов 43
Метки перевод чисел, система счисления (Все метки)
Студворк — интернет-сервис помощи студентам
Довольно частенько спрашивают перевод из одной СС в другую и поэтому я решил выложить исходник по переводу.Думаю кому нибудь да понадобится.Можно усовершенствовать но мне лень :
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

uses
  CRT;
 
const
  a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
 в ней символов}
var
  n, r: real;
  rez, s, s2, s3: string;
  t, cc, ind, cc2, k: integer;
 
{процедура для разделения дробной и целой части числа}
procedure Del(var ss: string);
var
  i: integer;
begin
  ind := 0;  
  s2 := '';
  for i := 1 to length(ss) do  {идём по строке}
    if ss[i] in [',', '.'] then {если символ входит в множество то}
    begin
      ind := i; {запомнили его индекс}
      break{прервали цикл}
    end
    else    {иначе}
      s2 := s2 + ss[i]; {пишим в строку по символам целую часть}
  s3 := '';  {инициализируем переменную}
  if ind <> 0 then {если символ из множества [',','.'] есть в строке то}
  begin
    delete(s, 1, ind); {удаляем с первой позиции по ind элементы из строки
    (т.е. целую часть + [',','.'])}
    s3 := ss; {остаток исходной строки заносим в s3 (т.е. дробную часть)}
  end;
end;
 
{функция для перевода (целой части числа) из любой СС в 10-ю}
function ToDec(var ss: string; cc: byte): integer;
var
  i, n, sum: integer;
begin
  sum := 0;
  n := length(ss); {присваиваем n - длину строки ss}
  for i := 1 to n do {идём по строке}
  begin
    dec(n); {уменьшаем счётчик на 1}
    sum := sum + round((pos(ss[i], a) - 1) * exp(ln(cc) * n)); {суммируем число (найденное в
    строке по позиции символа-1 (pos(ss[i],a)-1)) в степени dec(n)}
  end;
  ToDec := sum;
end;
 
{функция для перевода целой части числа из 10-й в любую сс}
function Cel(d: real; c: integer): string;
var
  s: string;
  n2: integer;
begin
  n2 := round(int(d)); {берём целую часть от числа}
  s := '';   
  repeat
    s := ((a[n2 mod c + 1]) + s); {повторяем пока число не будет равно нулю берём целую часть при
    делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем
    результат посимвольно в строку s}
    n2 := n2 div c;
  until (n2 = 0);
  Cel := s;
end;
 
{функция для перевода дробной части числа из 10-й в любую сс}
function Drob(var d: real; t, c: integer): string;
var
  s: string;
  l2, k, n3: real;
  i, l: integer;
begin
  k := d - int(d);
  s := '';
  i := 0;
  if t <> 0 then  {если точность не равна 0 то переводим}
  begin
    repeat
      l2 := k * c;
      k := frac(l2); {умножаем число на c (основание СС) берём целую часть и
      снова умножаем дробную}
      s := s + a[round(int(l2)) + 1]; {ищим в строке элемент на позиции round(int(l2))+1
      (целая часть от умножения числа на c +1)}
      inc(i); {увеличиваем счётчик}
    until i = t;
  end
  else  {иначе}
   s := '0'; {присваиваем s '0'}
  Drob := s;
end;
 
{перевод (дробной части) из произвольной сс  в 10-ю}
function drob2(ss: string; c: integer): real;
var
  i: integer;
  sum: real;
begin
  for i := 1 to length(ss) do {идём по строке (по дробной части)}
    sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); {умножаем позицию символа строки -1
  на онование системы счисления в степени -i}
  drob2 := sum;
end;
 
begin
  ClrScr;
  repeat
    write('Из какой будем переводить сс: ');
    readln(cc2)
  until cc2 in [2..36]; {проверка ввода}
  write('Введите СС в которую хотите перевести: ');
  readln(cc);
  if cc2 = 10 then {если перевод из 10 то юзаем функции Cel и Drob}
  begin
    write('Введите число в ', cc2, '-й СС: ');
    readln(n);
    write('Введите точность: ');
    readln(t);
    if ((n - round(int(n))) = 0) then {если дробная часть числа=0 то юзаем Cel}
      rez := Cel(n, cc)
    else     {иначе юзаем обе и добавляем , между дробной и целой}
      rez := Cel(n, cc) + ',' + Drob(n, t, cc);
  end
  else {иначе если перевод не из 10-й СС}
  begin
    write('Введите число в ', cc2, '-й СС: ');
    readln(s);
    Del(s); {разбиваем на дробную и целую части строку}
    if ind = 0 then
      rez := Cel(ToDec(s2, cc2), cc) {переводим сначала из любой в 10-ю сс, а затем из
     10-й в любую}
    else
    begin
      r := drob2(s3, cc2); {переводим дробную часть числа}
      rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(r, length(s3), cc); {переводим из любой сс
      в другую }
    end;
  end;
  write(rez); { THE END }
  readkey
end.
Добавил функцию для проверки принадлежности числа заданной СС и кое что по мелочам:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

uses
  CRT;
 
const
  a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
 в ней символов}
var
  n: real;
  rez, s, s2, s3: string;
  t, cc, ind, cc2, k: integer;
 
{процедура для разделения дробной и целой части числа}
procedure Del(var ss: string);
var
  i: integer;
begin
  ind := 0;  {инициализируем переменные}
  s2 := '';
  for i := 1 to length(ss) do  {идём по строке}
    if ss[i] in [',', '.'] then {если символ входит в множество то}
    begin
      ind := i; {запомнили его индекс}
      break{прервали цикл}
    end
    else    {иначе}
      s2 := s2 + ss[i]; {пишим в строку по символам целую часть}
  s3 := '';
  if ind <> 0 then {если символ из множества [',','.'] есть в строке то}
  begin
    delete(s, 1, ind); {удаляем с первой позиции по ind элементы из строки
    (т.е. целую часть + [',','.'])}
    s3 := ss; {остаток исходной строки заносим в s3 (т.е. дробную часть)}
  end;
end;
 
{функция для перевода (целой части числа) из любой СС в 10-ю}
function ToDec(var ss: string; cc: byte): integer;
var
  i, n, sum: integer;
begin
  sum := 0;
  n := length(ss); {присваиваем n - длину строки ss}
  for i := 1 to n do {идём по строке}
  begin
    dec(n); {уменьшаем счётчик на 1}
    sum := sum + round((pos(ss[i], a) - 1) * exp(ln(cc) * n)); {суммируем число (найденное в
    строке по позиции символа-1 (pos(ss[i],a)-1)) в степени dec(n)}
  end;
  ToDec := sum;
end;
 
{функция для перевода целой части числа из 10-й в любую сс}
function Cel(d: real; c: integer): string;
var
  s: string;
  n2: integer;
begin
  n2 := round(int(d)); {берём целую часть от числа}
  s := '';   {инициализируем переменную}
  repeat
    s := ((a[n2 mod c + 1]) + s); {пока число не будет равно нулю берём целую часть при
    делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем
    результат посимвольно в строку s}
    n2 := n2 div c;
  until (n2 = 0);
  Cel := s;
end;
 
{функция для перевода дробной части числа из 10-й в любую сс}
function Drob(d: real; t, c: integer): string;
var
  s: string;
  l2, k, n3: real;
  i, l: integer;
begin
  k := d - int(d);
  s := '';
  i := 0;
  if t <> 0 then  {если точность не равна 0 то переводим}
  begin
    repeat
      l2 := k * c;
      k := frac(l2); {умножаем число на c (основание СС) берём целую часть и
      снова умножаем дробную}
      s := s + a[round(int(l2)) + 1]; {ищим в строке элемент на позиции round(int(l2))+1
      (целая часть от умножения числа на c +1)}
      inc(i); {увеличиваем счётчик}
    until i = t;
  end
  else  {иначе}
   s := '0'; {присваиваем s '0'}
  Drob := s;
end;
 
{функция для проверки может ли быть это число в заданной системе счисления}
Function prov(c:integer;s:string):boolean;
Var
 i,kol,j:integer;
begin
kol:=0;
for i:=1 to c do {идём по строке а (где с-заданная система счисления)}
begin
 for j:=1 to length(s) do {идём по строке s (заданному числу)}
 if s[j]=a[i] then {если символ нашего числа равен символу из строки а то}
  inc(kol); {увеличиваем счётчик на 1}
end;
if kol=length(s) then {если кол-во символов=длине строки (т.е. все символы в этой СС то) }
 prov:=true {истина}
else  {иначе}
 prov:=false; {ложь}
end;
 
{перевод (дробной части) из произвольной сс  в 10-ю}
function drob2(ss: string; c: integer): real;
var
  i: integer;
  sum: real;
begin
  for i := 1 to length(ss) do {идём по строке (по дробной части)}
    sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); {умножаем позицию символа строки -1
  на онование системы счисления в степени -i}
  drob2 := sum;
end;
 
begin
  ClrScr;
  repeat
    write('Из какой будем переводить сс: ');
    readln(cc2);
    write('Введите СС в которую хотите перевести: ');
    readln(cc);
  until (cc2 in [2..36]) and (cc in [2..36]); {проверка ввода}
  repeat
   write('ввод числа в ', cc2, '-й СС: ');
   readln(n);
   str(n,s); {переводим в строку}
   Del(s); {разбиваем на дробную и целую части строку}
   if not prov(cc2,s2) or not prov(cc2,s3) then {если дробная или целая части заданы не верно (т.е. true) то выводим сообщение}
    write('Некорректное число.Повторите ')
  until prov(cc2,s2) and prov(cc2,s3); {проверка на соответствие числа заданной СС}
  if cc2 = 10 then {если перевод из 10 то юзаем функции Cel и Drob}
  begin
    write('Введите точность: ');
    readln(t);
    if ((n - round(int(n))) = 0) then {если дробная часть числа=0 то юзаем Cel}
      rez := Cel(n, cc)
    else     {иначе юзаем обе и добавляем , между дробной и целой}
      rez := Cel(n, cc) + ',' + Drob(n, t, cc);
  end
  else {иначе если перевод не из 10-й СС}
  begin
    if ind = 0 then
      rez := Cel(ToDec(s2, cc2), cc) {переводим сначала из любой в 10-ю сс, а затем из
     10-й в любую}
    else
      rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(drob2(s3, cc2), length(s3), cc); {переводим из любой сс
      в другую }
  end;
  write('Число ',n,'_',cc2,' в ',cc,'-й системе счисления:=',rez); { THE END }
  readkey
end.
Забыл добавить писалось в паскаль ABC

Для ТP:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

Uses
 CRT;
 
const
 a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
  в ней символов}
var
  rez, s, s2, s3: string;
  t, cc, ind, cc2, k: integer;
 
{процедура для разделения дробной и целой части числа}
procedure Del(var ss: string);
var
  i: integer;
begin
  ind := 0;  {инициализируем переменные}
  s2 := '';
  for i := 1 to length(ss) do  {идём по строке}
    if ss[i] in [',', '.'] then {если символ входит в множество то}
    begin
      ind := i; {запомнили его индекс}
      break{прервали цикл}
    end
    else    {иначе}
      s2 := s2 + ss[i]; {пишим в строку по символам целую часть}
  s3 := '';  {инициализируем переменную}
  if ind <> 0 then {если символ из множества [',','.'] есть в строке то}
  begin
    delete(s, 1, ind); {удаляем с первой позиции по ind элементы из строки
    (т.е. целую часть + [',','.'])}
    s3 := ss; {остаток исходной строки заносим в s3 (т.е. дробную часть)}
  end;
end;
 
{функция для перевода (целой части числа) из любой СС в 10-ю}
function ToDec(var ss: string; cc: byte): string;
var
  i, n, sum: longint;
  s:string;
begin
  sum := 0;  {инициализируем переменную}
  n := length(ss); {присваиваем n - длину строки ss}
  for i := 1 to n do {идём по строке}
  begin
    dec(n); {уменьшаем счётчик на 1}
    sum := sum + round((pos(ss[i], a) - 1) * exp(ln(cc) * n)); {суммируем число (найденное в
    строке по позиции символа-1 (pos(ss[i],a)-1)) в степени dec(n)}
  end;
  str(sum,s); {переводим число в строку}
  ToDec := s;
end;
 
{функция для перевода целой части числа из 10-й в любую сс}
function Cel(d: string; c: integer): string;
var
  s: string;
  k: integer;
  n2:real;
begin
  val(d,n2,k); {переводим строку в число}
  s := '';   {инициализируем переменную}
  repeat
    s := ((a[round(n2) mod c + 1]) + s); {пока число не будет равно нулю берём целую часть при
    делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем
    результат посимвольно в строку s}
    n2 := round(n2) div c;
  until (n2 = 0);
  Cel := s;
end;
 
{функция для перевода дробной части числа из 10-й в любую сс}
function Drob(d: string; t, c: integer): string;
var
  s, l: string;
  l2, m: real;
  i, k: integer;
begin
if pos('E',d)=0 then {если в строке нет E то)
то добавляем к строке "0."}
 val(('0.'+d),m,k)
else {иначе}
val(d,m,k); {переводим строку (без добавления "0.") в число}
  s := '';  {инициализируем переменные}
  i := 0;
  if t <> 0 then  {если точность не равна 0 то переводим}
  begin
    repeat
      l2 := m * c;
      m := frac(l2); {умножаем число на c (основание СС) берём целую часть и
      снова умножаем дробную}
      s := s + a[round(int(l2)) + 1]; {ищим в строке элемент на позиции round(int(l2))+1
      (целая часть от умножения числа на c +1)}
      inc(i); {увеличиваем счётчик}
    until i = t;
  end
  else  {иначе}
   s := '0'; {присваиваем s '0'}
  Drob := s;
end;
 
{функция для проверки может ли быть это число в заданной системе счисления}
Function prov(c:integer;s:string):boolean;
Var
 i,kol,j:integer;
begin
kol:=0; {инициализируем переменную}
for i:=1 to c do {идём по строке а (где с-заданная система счисления)}
begin
 for j:=1 to length(s) do {идём по строке s (заданному числу)}
 if s[j]=a[i] then {если символ нашего числа равен символу из строки а то}
  inc(kol); {увеличиваем счётчик на 1}
end;
if kol=length(s) then {если кол-во символов=длине строки (т.е. все символы в этой СС то) }
 prov:=true {истина}
else  {иначе}
 prov:=false; {ложь}
end;
 
{перевод (дробной части) из произвольной сс  в 10-ю}
function drob2(ss: string; c: integer): string;
var
  i: integer;
  sum: real;
  s:string;
begin
  for i := 1 to length(ss) do {идём по строке (по дробной части)}
    sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); {умножаем позицию символа строки -1
  на онование системы счисления в степени -i}
  str(sum,s); {переводим из числа в строку}
  drob2 := s;
end;
 
 
begin
  ClrScr;
  repeat
    write('Из какой будем переводить сс: ');
    readln(cc2);
    write('Введите СС в которую хотите перевести: ');
    readln(cc);
  until (cc2 in [2..36]) and (cc in [2..36]); {проверка ввода}
  repeat
   write('ввод числа в ', cc2, '-й СС: ');
   readln(s);
   Del(s); {разбиваем на дробную и целую части строку}
   if not prov(cc2,s2) and not prov(cc2,s3)  then
    write('Некорректное число.Повторите ')
  until prov(cc2,s2) and prov(cc2,s3);
  if cc2 = 10 then {если перевод из 10 то юзаем функции Cel и Drob}
  begin
    write('Введите точность: ');
    readln(t);
    if (s3='') then {если дробная часть числа=0 то юзаем Cel}
      rez := Cel(s2, cc)
    else     {иначе юзаем обе и добавляем , между дробной и целой}
      rez := Cel(s2, cc) + ',' + Drob(s3, t, cc);
  end
  else {иначе если перевод не из 10-й СС }
  begin
    if ind = 0 then
      rez := Cel(ToDec(s2, cc2), cc) {переводим сначала из любой в 10-ю сс, а затем из
     10-й в любую}
    else
      rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(drob2(s3, cc2), length(s3), cc); {переводим из любой сс
      в другую }
  end;
  write('Число ',s,'_',cc2,' в ',cc,'-й системе счисления:=',rez); { THE END }
  readkey
end.
36
Лучшие ответы (1)
Сообщение: #1353053
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
 06.02.2011, 22:42
Ответы с готовыми решениями:

Перевод в различные системы счисления
Доброго времени суток. Тут мне выдали пару задач которые нужно решить, но я немного отсталый в программирование. Помогите пожалуйста. А...

Перевод в различные системы счисления
Здравствуйте, возникла проблема, не могу разобраться с преобразованием числа в обратный и дополнительный код. Если с переводом из одной...

Перевод чисел в различные системы счисления
Составьте, пожалуйста, программу, которая переводит натуральное число (не более 10^9) в систему счисления, основание которой (от 2 до 9)...

43
54 / 54 / 23
Регистрация: 02.02.2011
Сообщений: 436
07.02.2011, 17:37
Что то программа большая. Я помню уложился в 17 строчек, но моя программа переводила только челые числа из любой в любую
0
07.02.2011, 17:51  [ТС]

Не по теме:

без проверок,функций и только перевод целых,займёт строк 20 от силы.Но это будет обрубок а не программа.Да и к чему этот комментарий?

1
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
08.02.2011, 18:37  [ТС]
Лучший ответ Сообщение было отмечено ildwine как решение

Решение

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

uses
  CRT;
 
const
  a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
 в ней символов}
var
  n: real;
  rez, s, s2, s3, s4: string;
  t, cc, ind, cc2, k, l, t2: integer;
 
{процедура для разделения дробной и целой части числа}
procedure Del(var ss: string);
var
  i: integer;
begin
  s2:=copy(ss,1,pos('.',ss)-1); {присваиваем строке s2 с первого символа по индекс "."-ки -1 (т.е. целую часть)}
  delete(ss, 1,pos('.',ss)); {удаляем с первой позиции по ind элементы из строки
  (т.е. целую часть + ".")}
  s3 := ss; {остаток исходной строки заносим в s3 (т.е. дробную часть)}
end;
 
{функция для перевода (целой части числа) из любой СС в 10-ю}
function ToDec(ss2: string; cc: byte): integer;
var
  i, n, sum: integer;
begin
  sum := 0;
  n := length(ss2); {присваиваем n - длину строки ss}
  for i := 1 to n do {идём по строке}
  begin
    dec(n); {уменьшаем счётчик на 1}
    sum := sum + round((pos(ss2[i], a) - 1) * exp(ln(cc) * n)); {суммируем число (найденное в
    строке по позиции символа-1 (pos(ss[i],a)-1)) в степени dec(n)}
  end;
  ToDec := sum;
end;
 
{функция для перевода целой части числа из 10-й в любую сс}
function Cel(d: real; c: integer): string;
var
  s: string;
  n2: integer;
begin
  n2 := round(int(d)); {берём целую часть от числа}
  s := '';   {инициализируем переменную}
  repeat
    s := ((a[n2 mod c + 1]) + s); {пока число не будет равно нулю берём целую часть при
    делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем
    результат посимвольно в строку s}
    n2 := n2 div c;
  until (n2 = 0);
  Cel := s;
end;
 
{функция для перевода дробной части числа из 10-й в любую сс}
function Drob(d: real; t, c: integer): string;
var
  s: string;
  l2, k, n3: real;
  i, l: integer;
begin
  k := d - int(d);
  s := '';
  i := 0;
  if t <> 0 then  {если точность не равна 0 то переводим}
  begin
    repeat
      l2 := k * c;
      k := frac(l2); {умножаем число на c (основание СС) берём целую часть и
      снова умножаем дробную}
      s := s + a[round(int(l2)) + 1]; {ищим в строке элемент на позиции round(int(l2))+1
      (целая часть от умножения числа на c +1)}
      inc(i); {увеличиваем счётчик}
    until i = t;
  end
  else  {иначе}
   s := '0'; {присваиваем s '0'}
  Drob := s;
end;
 
{функция для проверки может ли быть это число в заданной системе счисления}
Function prov(c:integer;s:string):boolean;
Var
 i,kol,j:integer;
begin
kol:=0;
for i:=1 to c do {идём по строке а (где с-заданная система счисления)}
begin
 for j:=1 to length(s) do {идём по строке s (заданному числу)}
 if s[j]=a[i] then {если символ нашего числа равен символу из строки а то}
  inc(kol); {увеличиваем счётчик на 1}
end;
if kol=length(s) then {если кол-во символов=длине строки (т.е. все символы в этой СС то) }
 prov:=true {истина}
else  {иначе}
 prov:=false; {ложь}
end;
 
{перевод (дробной части) из произвольной сс  в 10-ю}
function drob2(ss: string; c: integer): real;
var
  i: integer;
  sum: real;
begin
  for i := 1 to length(ss) do {идём по строке (по дробной части)}
    sum := sum + (pos(ss[i], a) - 1) * exp(ln(c) * -i); {умножаем позицию символа строки -1
  на онование системы счисления в степени -i}
  drob2 := sum;
end;
 
begin
  ClrScr;
  repeat
    write('Из какой будем переводить сс: ');
    readln(cc2);
    write('Введите СС в которую хотите перевести: ');
    readln(cc);
  until (cc2 in [2..36]) and (cc in [2..36]); {проверка ввода}
  repeat
   write('ввод числа в ', cc2, '-й СС: ');
   readln(s);
   s4:=s;
   if pos(',',s)<>0 then {если в строке есть "," то}
    s[pos(',',s)]:='.'; {заменяем в строке , на . (для перевода в действительное число)}
   t2:=pos('.',s); {позиция точки в строке}
   val(s,n,l); {переводим в действительное число}
   Del(s); {разбиваем на дробную и целую части строку}
   if not prov(cc2,s2) or not prov(cc2,s3) then {если дробная или целая части заданы не верно (т.е. true) то выводим сообщение}
    write('Некорректное число.Повторите ')
  until prov(cc2,s2) and prov(cc2,s3); {проверка на соответствие числа заданной СС}
  write('Введите точность: ');
    readln(t);
  if cc2 = 10 then {если перевод из 10 то юзаем функции Cel и Drob}
  begin
    if ((n - round(int(n))) = 0) then {если дробная часть числа=0 то юзаем Cel}
      rez := Cel(n, cc)
    else     {иначе юзаем обе и добавляем , между дробной и целой}
      rez := Cel(n, cc) + ',' + Drob(n, t, cc);
  end
  else {иначе если перевод не из 10-й СС}
  begin
    if t2=0 then {если в строке нет .}
      rez := Cel(ToDec(s3, cc2), cc) {переводим сначала из любой в 10-ю сс, а затем из
     10-й в любую}
    else
      rez := Cel(ToDec(s2, cc2), cc) + ',' + drob(drob2(s3, cc2),t, cc); {переводим из любой сс
      в другую }
  end;
  write('Число ',s4,'_',cc2,' в ',cc,'-й системе счисления:=',rez); { THE END }
  readkey
end.
Исправлена программа N_2.

Не по теме:

Извиняюсь...

9
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 13
07.05.2011, 16:29
Ввожу число но не могу написать ее систему(666,6 в 10 системе)по 1 предложенной программе, как это систему писать в паскале?666,610
0
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
07.05.2011, 17:04  [ТС]
#4
Вот её и бери.Если в T.P. работаешь
1
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 9
07.05.2011, 17:06
Ребят, не совсем понял, а для чего поле "Введите точность"? Объясните плиз...
А то у меня по курсовой такое задание, а я чет не вкурил, объяснить не смогу... Если можно поподробнее. А так прога работает исправно!) Огромное спасибо!!!
0
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 13
08.05.2011, 11:27
Что то не получается я работаю на pascal ABC и результат, когда надо вводить это число 666,610 вот эту 10 как надо вводить не знаю...
0
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
08.05.2011, 11:54  [ТС]
А 10 просто ввести не судьба?Гений...
0
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 13
08.05.2011, 16:41
Я пытался но ничего не выходило и так (10); и так 666,6 10; 666,6(10)но ничего не выходило, и всегда выходило Ошибка ввода
0
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
08.05.2011, 17:06  [ТС]
а нафига ты скобки вводишь то?
0
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 13
08.05.2011, 21:38
я же говорил что все способы пробовал но ничего не выходило
0
 Аватар для iama
1360 / 988 / 119
Регистрация: 30.07.2010
Сообщений: 5,297
08.05.2011, 21:46
Askhat 92, такой способ представления числа не является общепринятым
0
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
08.05.2011, 22:10  [ТС]
я же говорил что все способы пробовал но ничего не выходило

Не по теме:

в таком случае ни чем вам помочь не могу раз вы даже число ввести не в состоянии.

0
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
08.05.2011, 22:18  [ТС]
хотя нет.Помочь могу.Специально для тебя я приложу скрин как верно вводить число.По первой программе.
Миниатюры
Перевод в различные системы счисления  
1
0 / 0 / 0
Регистрация: 07.05.2011
Сообщений: 9
11.05.2011, 16:37
Ребят!!! Срочно нужна блоксхема этой программы... Может кто сделать плизззз...?
0
Left1234
25.09.2011, 15:47
супер хакер помоги пожалуйсто нужна програма в паскале каторая будет переводить числа 10 тичной системы в n-ричную это задании 11 класса и всякеих заумных команд мы неиспользуем типо
procedure uses Drob зделай пождалусто простую програму перевода из десятичной в н ричную систему на уровень школьника пожалусто если несложно буду очень благодарен
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
25.09.2011, 16:11  [ТС]
перевод каких чисел? натуральных,дробных,отрицательных,положи тельных?ты бы хоть указал для начала.
0
Left1234
25.09.2011, 20:30
натуральных нада заранее спасибо надеюсь выручишь
 Аватар для SuPeR XaKer
2857 / 1986 / 788
Регистрация: 23.09.2010
Сообщений: 4,876
25.09.2011, 23:28  [ТС]
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

Uses CRT;
 
const a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
 
var s: string;
    c, n2: integer;
 
begin
 ClrScr;
 repeat
  write('Введите число в десятичной СС: ');
  readln(n2);
 until n2>0;
 repeat
  write('Введите систему счисления в которую хотите перевести число: ');
  readln(c);
  if c=10 then write('А чё переводить то когда уже в десятичной!!!')
  else write('Повтори ввод!!!')
 until c in [2..9,11..36];
 s := '';
 repeat
  s := ((a[n2 mod c + 1]) + s);
  n2 := n2 div c
 until (n2 = 0);
 write('Число ',n2,'_10',' в ',c,'-й системе счисления:=',s);
 readkey
end.
4
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
 25.09.2011, 23:28
Помогаю со студенческими работами здесь

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

Перевод любого числа из 16 системы счисления в 2 систему счисления.
Здравствуйте,помогите решить задачку в Pascal !!! Для перевода любого числа из 16 системы счисления в 2 систему счисления. ...

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

Перевод из системы счисления 8 в 16
дано число в 8-ной системе счисления, нужно перевести его в 16-ную.

Перевод из системы счисления 16 в 10
Напишите программу, которая бы вводила,выводила шестнадцатиричные числа и переводила их в десятичную систему счисления))) помогите...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
1 из 3 1 23 »
Новые блоги и статьи
Новый CodeBlocs. Версия 25.03
palva 04.01.2026
Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .
Модель микоризы: классовый агентный подход
anaschu 02.01.2026
Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .
Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути
Programma_Boinc 01.01.2026
Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост.
Programma_Boinc 28.12.2025
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / **********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / **********/ gallery/ bKBkQFf Пост отсюда. . .
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США.
Programma_Boinc 26.12.2025
Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .
Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка.
Programma_Boinc 23.12.2025
Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~
and_y87 14.12.2025
PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .
Как объединить две одинаковые БД Access с разными данными
VikBal 11.12.2025
Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук
volvo 07.12.2025
Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
 Музыка, написанная Искусственным Интеллектом
volvo 04.12.2025
Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru