Форум программистов, компьютерный форум CyberForum.ru
Наши страницы

Pascal (Паскаль)

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 419, средняя оценка - 4.71
SuPeR XaKer
2841 / 1970 / 377
Регистрация: 23.09.2010
Сообщений: 4,877
#1

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

06.02.2011, 22:42. Просмотров 58998. Ответов 41

Довольно частенько спрашивают перевод из одной СС в другую и поэтому я решил выложить исходник по переводу.Думаю кому нибудь да понадобится.Можно усовершенствовать но мне лень :
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.
34
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
06.02.2011, 22:42
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Перевод в различные системы счисления (Pascal):

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

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

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

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

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

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

41
kverrian
0 / 0 / 0
Регистрация: 12.03.2012
Сообщений: 5
21.04.2012, 22:17 #31
а можно ли модернизировать вашу программу , чтобы точность определялась автоматически???
0
pashtet1991
1 / 1 / 0
Регистрация: 24.02.2010
Сообщений: 8
21.04.2012, 22:41 #32
можно для определения точности использовать некую функцию, зависящую от исходной и искомой СС, но легче сделать фиксированную (излишнюю) точность, т.к для перевода одного разряда после запятой из 16СС в 2СС нужно 4 знака, для 5СС-2СС=3 знака и для 8СС-2СС тоже 3 знака, а для 2СС-16СС 1/4 знака т.е зависимость нелинейная, лучше взять избыточную константу (например 5 или 6), но возможно переполнение разрядной сетки, надо проверять, писал по теории.

Добавлено через 10 минут
например использовать цикл if ss1>ss2 then i:=5*length(s) else i:=lenght(s) где СС1-исходная СС2-искомая i-точность, s-дробная часть числа
1
kverrian
0 / 0 / 0
Регистрация: 12.03.2012
Сообщений: 5
21.04.2012, 23:12 #33
Цитата Сообщение от pashtet1991 Посмотреть сообщение
можно для определения точности использовать некую функцию, зависящую от исходной и искомой СС, но легче сделать фиксированную (излишнюю) точность, т.к для перевода одного разряда после запятой из 16СС в 2СС нужно 4 знака, для 5СС-2СС=3 знака и для 8СС-2СС тоже 3 знака, а для 2СС-16СС 1/4 знака т.е зависимость нелинейная, лучше взять избыточную константу (например 5 или 6), но возможно переполнение разрядной сетки, надо проверять, писал по теории.

Добавлено через 10 минут
например использовать цикл if ss1>ss2 then i:=5*length(s) else i:=lenght(s) где СС1-исходная СС2-искомая i-точность, s-дробная часть числа
Я протестил....почти ничего не изменилось : при вводе AA.37 в 16 выводит 170.21 а обратно AA.35
0
pashtet1991
1 / 1 / 0
Регистрация: 24.02.2010
Сообщений: 8
21.04.2012, 23:43 #34
ну во-первых, мой листинг программы так и работает, могу выслать в ближайшие пару дней на e-mail, а во-вторых перевод туда-обратно не может так сильно отличаться!
0
kverrian
0 / 0 / 0
Регистрация: 12.03.2012
Сообщений: 5
22.04.2012, 12:28 #35
не могли ли вы посмотреть мою программу и подсказать как написать эту функцию ...
Программа перевода из одной системы счисления в другую
0
ArtiDelion
Сообщений: n/a
30.05.2012, 22:32 #36
Добрый день уважаемые форумчане. Только начал изучать Паскаль. Помогите плиз новичку. Мне нужно написать 2 небольшие программки, одна чтобы переводила числа из 19-тиричной сс в 10-тичную, а вторая наоборот из десятичной в 19-тиричную. Пытался всячески переделать и подстроить для этого дела шаблон из первого поста, но у меня получилась какая-то ересь. Если нетрудно, покажите как они должны выглядеть, с пояснениям в фигурных скобках, что какие переменные значат и основные процессы, хотелось бы не просто сдать готовые работы, но и самому разобраться. Заранее благодарю.
Puporev
Модератор
52128 / 39986 / 13353
Регистрация: 18.05.2008
Сообщений: 92,233
31.05.2012, 09:04 #37
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
{перевод из 19->10}
uses crt;
const digit:string[19]='0123456789ABCDEFGHI'; //цифры в СС 19
var s:string;//строка, число в СС 19
    n:integer;//число в СС 10
    i:integer;//счетчик
    c:char;//переменная для ввода символов
begin
writeln('Введите число в СС 19, окончание ввода Enter');
s:='';
repeat
c:=readkey;
if c in ['a'..'i'] then c:=UpCase(c);
if c in ['0'..'9','A'..'I'] then
 begin
  write(c);
  s:=s+c;
 end;
if c=#13 then writeln;
until c=#13;
n:=0;//пока число=0
while s[1]='0' do delete(s,1,1);//удалим ведущие ноли если они есть
for i:=1 to length(s) do//идем по строке
n:=n*19+pos(s[i],digit)-1;//умножаем уже имеющееся число на 19
                          //и прибавляем номер символа в digits-1(поскольку 0 имеет номер 1)
write('Число в СС 10=',n);
end.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
{перевод из 10->19}
uses crt;
const digit:string[19]='0123456789ABCDEFGHI'; ////цифры в СС 19
var n:integer;//число в СС 10
    s:string;//строка=число в СС 19
begin
write('Число в СС 10=');
readln(n);
s:='';//пока пустая
repeat
s:=digit[(n mod 19)+1]+s;//берем остаток от деления числа на 19
                         //добавляем 1 и берем цифру с этим номером из digits
                         //дописываем ее в начало строки
n:=n div 19;//сокращаем число в 19 раз
until n=0;//пока число не 0
write('Число в СС 19=',s);
end.
1
wasex
0 / 0 / 0
Регистрация: 31.05.2012
Сообщений: 3
31.05.2012, 11:05 #38
Онлан калькулятор для перевода чисел в разные системы счисления Тут можно проверить результаты
http://векторное-управление.рф/perevod-chisel.html
0
Newchap
4 / 4 / 1
Регистрация: 17.09.2013
Сообщений: 179
25.09.2013, 15:22 #39
Добрый день, был бы очень признателен, если бы вы выложили программу, которая переводит целые числа из системы в систему(из любой в любую). Голову сломал уже себе, а то, что в данной теме и на форуме есть не подходит.
Надеюсь, что за некропостинг не покарают.
0
Puporev
Модератор
52128 / 39986 / 13353
Регистрация: 18.05.2008
Сообщений: 92,233
25.09.2013, 15:34 #40
Для 2-16, нужно больше, увеличьте размер массива цифр.
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
uses
  crt;
var
  cs1,cs2,res,change:integer;
  TD:string;
{функция перевода Dec числа в любую сс}
function FromDec(n,r:longint):string;
var
  s:String;
const
  digit:string[16]='0123456789ABCDEF';
begin
  s:='';
  repeat
    s:=digit[(n mod r)+1]+s;
    n:=n div r;
  until n=0;
    FromDec:=s;
end;
{фунция перевода любой сс в Dec}
function ToDec(n:string;r:longint):longint;
var
  m,i:longint;
const
  digit:string[16]='0123456789ABCDEF';
begin
  m:=0;
  while n[1]='0' do
    delete(n,1,1);
  for i:=1 to length(n) do
    m:=m*r+pos(n[i],digit)-1;
  ToDec:=m;
end;
{осоновная программы}
begin
  clrscr;
  writeln('Введите из какой сс');
  readln(cs1);
  writeln('Введите число в соответствии с сс');
  readln(TD);
  writeln('Введите в какую сс');
  readln(cs2);
  writeln(FromDec(ToDec(TD,cs1),cs2));
readln
end.
2
Oleskon
1 / 1 / 0
Регистрация: 10.01.2014
Сообщений: 26
09.09.2014, 05:53 #41
Цитата Сообщение от SuPeR XaKer Посмотреть сообщение
s := ((a[n2 mod c + 1]) + s); {повторяем пока число не будет равно нулю берём целую часть при делении числа на основание и берём остаток + 1 от деления целой части на 16, записываем результат посимвольно в строку s}
Скажите, пожалуйста, почему здесь прибавляем единицу?!
1
Puporev
Модератор
52128 / 39986 / 13353
Регистрация: 18.05.2008
Сообщений: 92,233
09.09.2014, 07:04 #42
Потому что индексы в строке начинаются с 1, значения с 0.
Например a[1]='0', поэтому чтобы получить 0 нужно к остатку
например 1 div 2=0 прибавить 1, чтобы получить a[1]
0
09.09.2014, 07:04
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.09.2014, 07:04
Привет! Вот еще темы с ответами:

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

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

Перевод из системы счисления 10 в 8 - Pascal
Написать программу, которая вводит десятичное число и выводит его восьмеричный эквивалент. Желательно использовать простейшие функции. ...

Перевод чисел из системы счисления 16 в 2 - Pascal
прошу помочь с написанием программы: -Автоматический перевод двухразрядного шестнадцатиричного числа в двоичный код(т.е. сделать так...


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

Или воспользуйтесь поиском по форуму:
42
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru