Переделать программу в функцию

@Mikel23 · Регистрация: 04.05.2010

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

Программа переводит из 10 сс в любую сс
Не могу переделать в функцию:

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
uses crt;
var x, d, b, q, i: integer;
a, c: real;
st, s, f, ft, res: string;
begin
clrscr;
writeln('Vvedite chislo:');
readln(a);
x := trunc(a);
st := chr(46);
s := s + st;
writeln('Novaya sistema schisleniya (2, 8, 16): ');
readln(d);
b := 0;
c := frac(a);
repeat
i := i + 1;
c := c * d;
a := c;
b := trunc(c);
c := frac(c);
if b > 9 then st := chr(ord('A') - 10 + b) else str(b, st);
if i <= 5 then s := s + st;
until c = 0;
repeat
q := x mod d;
if q > 9 then ft := chr(ord('A') - 10 + q) else str(q, ft);
x := x div d;
f := ft + f;
until x <= q;
str(x, ft);
f := ft + f;
s := f + s;
writeln(s);
readln;
end.

@Puporev · 06.05.2010, 17:59

В функцию переделать не проблема, но программа написана криво, типа если ввести 15, то получим 0F. это нормальная запись числа?

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
uses crt;
function CC(a:real):string;
var x, d, b, q, i: integer;
    c: real;
st, s, f, ft, res: string;
begin
x := trunc(a);
st := chr(46);
s := s + st;
writeln('Novaya sistema schisleniya (2, 8, 16): ');
readln(d);
b := 0;
c := frac(a);
repeat
i := i + 1;
c := c * d;
a := c;
b := trunc(c);
c := frac(c);
if b > 9 then st := chr(ord('A') - 10 + b) else str(b, st);
if i <= 5 then s := s + st;
until c = 0;
repeat
q := x mod d;
if q > 9 then ft := chr(ord('A') - 10 + q) else str(q, ft);
x := x div d;
f := ft + f;
until x <= q;
str(x, ft);
f := ft + f;
s := f + s;
CC:=s;
end;
var n:real;
    s:string;
begin
clrscr;
writeln('Vvedite chislo:');
readln(n);
s:=CC(n);
writeln(s);
readln
end.

@Mikel23 · 07.05.2010, 08:05 **[ТС]**

вообще мне нужна только 10 - 8
Она вроде правильно работает
остальные я и не проверял.

Добавлено через 10 часов 46 минут

Сообщение от Puporev

В функцию переделать не проблема, но программа написана криво, типа если ввести 15, то получим 0F. это нормальная запись числа?

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
uses crt;
function CC(a:real):string;
var x, d, b, q, i: integer;
    c: real;
st, s, f, ft, res: string;
begin
x := trunc(a);
st := chr(46);
s := s + st;
writeln('Novaya sistema schisleniya (2, 8, 16): ');
readln(d);
b := 0;
c := frac(a);
repeat
i := i + 1;
c := c * d;
a := c;
b := trunc(c);
c := frac(c);
if b > 9 then st := chr(ord('A') - 10 + b) else str(b, st);
if i <= 5 then s := s + st;
until c = 0;
repeat
q := x mod d;
if q > 9 then ft := chr(ord('A') - 10 + q) else str(q, ft);
x := x div d;
f := ft + f;
until x <= q;
str(x, ft);
f := ft + f;
s := f + s;
CC:=s;
end;
var n:real;
    s:string;
begin
clrscr;
writeln('Vvedite chislo:');
readln(n);
s:=CC(n);
writeln(s);
readln
end.

Почему то криво считает после перевода в функцию
Дробную часть не считает вообще только точку ставит а при повторном прогоне программы задваивает ответ.(в переменной s(дробная часть) то же самое что и в f(целая часть) )
Т.е. если ввести 15,2 и перевод в 8-ричную
первый раз отвт 17,
а второй при тех же данных 1717,

При чем изначальная программа отрабатывает без ошибки и переводит дробную чась.
при 15,2
ответ 17,14631
Видимо где то в цикле неправильно
Посмотрите пожалуйста еще раз

@Puporev · 07.05.2010, 09:08

Сообщение от Mikel23

Почему то криво считает после перевода в функцию

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

@Mikel23 · 07.05.2010, 09:17 **[ТС]**

Я тоже так побывал так не получается.
Я по этому и помощи попросил...

@Puporev · 07.05.2010, 11:22

вообще мне нужна только 10 - 8

Тогда зачем все лишнее написано?

Добавлено через 35 минут
Вот программа для перевода вещественных чисел из СС 10 в СС 8.

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
uses crt;
const zn:string[8]='01234567';
function DecToOctTrunc(n:longint):string;{перевод целой части}
var s:string;
begin
s:='';
while n>0 do
 begin
  s:=zn[n mod 8+1]+s;
  n:=n div 8;
 end;
DecToOctTrunc:=s;
end;
function DecToOctFrac(x:real;t:byte):string;{перевод дробной части}
var s:string;
    a:integer;
begin
s:='.';
while length(s)-1<t do
 begin
  x:=x*8;
  a:=trunc(x);
  s:=s+zn[a+1];
  x:=x-a;
 end;
DecToOctFrac:=s;
end;
var n,f:real;{число и его дробная часть}
    c:longint;{целая часть}
    t:byte;{точность, сколько знаков после запятой}
begin
clrscr;
write('Число в системе 10=');
readln(n);
write('Количество знаков в дробной части t=');
readln(t);
c:=trunc(n);
f:=frac(n);
write('      в системе  8 =');
if t=0 then write(DecToOctTrunc(c))
else write(DecToOctTrunc(c),DecToOctFrac(f,t));
readln
end.

Добавлено через 1 час 6 минут
Поправил пару багов.

@Mikel23 · 07.05.2010, 15:48 **[ТС]**

Переделал вот что получилась... эта программа должна переводить 2 вещественных числа (первое больше второго) числа из 8 сс в 10 сс складывать, вычитать, умножать их между собой, и переводить результаты в 8-ричную.

Вообще еще бы надо чтоб она брала числа из файла in.txt, а результат писала в out.txt.
Помогите доделать..

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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
program Q160347;
uses crt;
 
{функция перевода из 10 в 8}
function CC(a:real):string;
var x, d, b, q, i: integer;
    c: real;
st, s, f, ft, res: string;
begin
s:='';
st:='';
f:='';
ft:='';
x := trunc(a);
st := chr(46);
s := s + st;
d:=8;
b := 0;
c := frac(a);
repeat
i := i + 1;
c := c * d;
a := c;
b := trunc(c);
c := frac(c);
str(b,st);
s:=s+st;
until c = 0;
repeat
q := x mod d;
str(q,ft);
x := x div d;
f := ft + f;
until x <= q;
str(x, ft);
f := ft + f;
s := f + s;
CC:=s;
end;
{
var n:real;
    s:string;
begin
clrscr;
writeln('Vvedite chislo:');
readln(n);
s:=CC(n);
writeln(s);
readln
end.}
 
 
{ Функция проверки правильности ввода }
 
function CheckOctR(const oct: String): Boolean;
var
  i: Byte;
  p, res: Boolean;
begin
  { Результат }
  res:= True;
  { Флаг точки }
  p:= False;
  { Если число отрицательное }
  if (oct[1] = '-') then
    i:= 2
  else
    i:= 1;
 
  { Перебор всех символов }
  while ((i <= Length(oct)) and res) do
  begin
    { Встретилась точка }
    if (oct[i] = '.') then
    begin
      { Если уже была точка }
      if (p) then
        { то результат "ЛОЖЬ" }
        res:= False;
      { Запоминаем точку }
      p:= True;
    end
    else
      { В восьмеричной с.с. цифры от 0 до 7 }
      res:= oct[i] in ['0'..'7'];
    Inc(i);
  end;
 
  CheckOctR:= res;
end;
 
 
 
 
 
 
{ Функция перевода вещественного числа }
{ из 8 в 10 с.с. }
 
 
function OctToReal(const oct: String): Real;
var
  res, tmp: Real;
  i, zero, lng: Byte;
begin
  { Результат }
  res:= 0.0;
  { Код нуля }
  zero:= Ord('0');
  { Длина введенной строки }
  lng:= Length(oct);
  { Если число отрицательное }
  if (oct[1] = '-') then
    { то начинаем со второго символа }
    i:= 2
  else
    { иначе - с первого }
    i:= 1;
 
 
  { 1. Перевод целой части числа в 10 с.с. }
  { Перебираем символы до конца строки }
  { или до точки }
  while ((i <= lng) and (oct[i] <> '.')) do
  begin
    res:= res*8.0;
    res:= res + (Ord(oct[i]) - zero);
    Inc(i);
  end;
 
 
  { 2. Перевод дробной части числа в 8 с.с. }
  { Временная переменная, хранит 8^(-i) }
  tmp:= 1.0/8.0;
  { Если еще не все число перебрали }
  if (i <= Length(oct)) then
    { Переходим к следующему символу }
    Inc(i);
  { Теперь перебираем до конца строки }
  while (i <= Length(oct)) do
  begin
    res:= res + tmp*(Ord(oct[i]) - zero);
    { При делении 8^(-(i - 1)) на 8 получаем 8^(-i) }
    tmp:= tmp/8.0;
    Inc(i);
  end;
 
  { Если было введено отрицательное число }
  if (oct[1] = '-') then
    { то меняем знак результата }
    res:= -res;
 
  OctToReal:= res;
end;
 
 
var
  sloct,vioct,umoct,deloct,anOct,anOct1: String;
  dec1,dec,k,k1,aReal,Slogen,vichitan,umnogen,delen: Real;
  err:integer;
 
begin
clrscr;
  { Вводим вещественное число 8 с.с. }
  Write('8-ричное = '); ReadLn(anOct);
  Write('8-ричное = '); ReadLn(anOct1);
  { Проверяем правильность ввода }
  if CheckOctR(anOct) then
    { преобразуем }
     begin
     dec:=OctToReal(anOct);
     dec1:=OctToReal(anOct1);
    WriteLn('10-тичное = ', dec:3:8);
    WriteLn('10-тичное = ',dec1:3:8);
 
   { val(anOct,k,err);{перевод из string в real
    val(anOct1,k1,err);  }
    k:=dec;
    k1:=dec1;
 
 
    Slogen:=k+k1;
    Vichitan:=k-k1;
    umnogen:=k*k1;
    delen:=k/k1;
    writeln('Сложение= ', slogen:3:3);
    writeln('Вычитание= ',vichitan:3:3);
    writeln('Умножение= ', umnogen:3:3);
    writeln('Деление= ', delen:3:3);
    sloct:=cc(slogen);
    vioct:=cc(vichitan);
    umoct:=cc(umnogen);
    deloct:=cc(delen);
 
    writeln('Сложение 8 = ', sloct);
    writeln('Вычитание 8= ',vioct);
    writeln('Умножение 8= ', umoct);
    writeln('Деление 8= ', deloct);
 
   end
    else
    { иначе сообщаем об ошибке }
    WriteLn('ERROR');
 
 
  { Ждем, когда пользователь нажмет [Enter] }
  ReadLn;
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
program Q160347;
uses crt;
const zn:string[8]='01234567';
{функция перевода из 10 в 8}
{function CC(a:real):string;
var x, d, b, q, i: integer;
    c: real;
st, s, f, ft, res: string;
begin
s:='';
st:='';
f:='';
ft:='';
x := trunc(a);
st := chr(46);
s := s + st;
d:=8;
b := 0;
c := frac(a);
repeat
i := i + 1;
c := c * d;
a := c;
b := trunc(c);
c := frac(c);
str(b,st);
s:=s+st;
until c = 0;
repeat
q := x mod d;
str(q,ft);
x := x div d;
f := ft + f;
until x <= q;
str(x, ft);
f := ft + f;
s := f + s;
CC:=s;
end;
{var n:real;
    s:string;
begin
clrscr;
writeln('Vvedite chislo:');
readln(n);
s:=CC(n);
writeln(s);
readln
end.}
 
 
{ Функция проверки правильности ввода }
 
function CheckOctR(const oct: String): Boolean;
var
  i: Byte;
  p, res: Boolean;
begin
  { Результат }
  res:= True;
  { Флаг точки }
  p:= False;
  { Если число отрицательное }
  if (oct[1] = '-') then
    i:= 2
  else
    i:= 1;
 
  { Перебор всех символов }
  while ((i <= Length(oct)) and res) do
  begin
    { Встретилась точка }
    if (oct[i] = '.') then
    begin
      { Если уже была точка }
      if (p) then
        { то результат "ЛОЖЬ" }
        res:= False;
      { Запоминаем точку }
      p:= True;
    end
    else
      { В восьмеричной с.с. цифры от 0 до 7 }
      res:= oct[i] in ['0'..'7'];
    Inc(i);
  end;
 
  CheckOctR:= res;
end;
 
 
 
 
 
 
{ Функция перевода вещественного числа }
{ из 8 в 10 с.с. }
 
 
function OctToReal(const oct: String): Real;
var
  res, tmp: Real;
  i, zero, lng: Byte;
begin
  { Результат }
  res:= 0.0;
  { Код нуля }
  zero:= Ord('0');
  { Длина введенной строки }
  lng:= Length(oct);
  { Если число отрицательное }
  if (oct[1] = '-') then
    { то начинаем со второго символа }
    i:= 2
  else
    { иначе - с первого }
    i:= 1;
 
 
  { 1. Перевод целой части числа в 10 с.с. }
  { Перебираем символы до конца строки }
  { или до точки }
  while ((i <= lng) and (oct[i] <> '.')) do
  begin
    res:= res*8.0;
    res:= res + (Ord(oct[i]) - zero);
    Inc(i);
  end;
 
 
  { 2. Перевод дробной части числа в 8 с.с. }
  { Временная переменная, хранит 8^(-i) }
  tmp:= 1.0/8.0;
  { Если еще не все число перебрали }
  if (i <= Length(oct)) then
    { Переходим к следующему символу }
    Inc(i);
  { Теперь перебираем до конца строки }
  while (i <= Length(oct)) do
  begin
    res:= res + tmp*(Ord(oct[i]) - zero);
    { При делении 8^(-(i - 1)) на 8 получаем 8^(-i) }
    tmp:= tmp/8.0;
    Inc(i);
  end;
 
  { Если было введено отрицательное число }
  if (oct[1] = '-') then
    { то меняем знак результата }
    res:= -res;
 
  OctToReal:= res;
end;
 
 
 
function DecToOctTrunc(n:longint):string;{перевод целой части при переводе в 8-10}
var s:string;
begin
s:='';
while n>0 do
 begin
  s:=zn[n mod 8+1]+s;
  n:=n div 8;
 end;
DecToOctTrunc:=s;
end;
 
 
function DecToOctFrac(x:real;t:byte):string;{перевод дробной части при переводе 8-10}
var s:string;
    a:integer;
begin
s:='.';
while length(s)-1<t do
 begin
  x:=x*8;
  a:=trunc(x);
  s:=s+zn[a+1];
  x:=x-a;
 end;
DecToOctFrac:=s;
end;
 
 
 
 
 
var
  fv,fu,fd,fs,n,f:real;{число и его дробная часть 8-10}
  c,cs,cv,cu,cd:longint;{целая часть 8-10}
  t:byte;
  sloct,vioct,umoct,deloct,anOct,anOct1: String;
  dec1,dec,k,k1,aReal,Slogen,vichitan,umnogen,delen: Real;
  err:integer;
 
begin
clrscr;
  { Вводим вещественное число 8 с.с. }
  Write('8-ричное = '); ReadLn(anOct);
  Write('8-ричное = '); ReadLn(anOct1);
  { Проверяем правильность ввода }
  if CheckOctR(anOct) then
    { преобразуем }
     begin
     dec:=OctToReal(anOct);
     dec1:=OctToReal(anOct1);
    WriteLn('10-тичное = ', dec:3:8);
    WriteLn('10-тичное = ',dec1:3:8);
 
   { val(anOct,k,err);{перевод из string в real
    val(anOct1,k1,err);  }
    k:=dec;
    k1:=dec1;
 
    Slogen:=k+k1;
    Vichitan:=k-k1;
    umnogen:=k*k1;
    delen:=k/k1;
    writeln('Сложение= ', slogen:3:3);
    writeln('Вычитание= ',vichitan:3:3);
    writeln('Умножение= ', umnogen:3:3);
    writeln('Деление= ', delen:3:3);
 
{    sloct:=cc(slogen);
    vioct:=cc(vichitan);
    umoct:=cc(umnogen);
    deloct:=cc(delen);
 
    writeln('Сложение 8 = ', sloct);
    wr
    iteln('Вычитание 8= ',vioct);
    writeln('Умножение 8= ', umoct);
    writeln('Деление 8= ', deloct); }
 
 
 
t:=3;{точность, сколько знаков после запятой}
{write('Число в системе 10=');
readln(n);}
 
 
cs:=trunc(slogen);
fs:=frac(slogen);
 
cv:=trunc(vichitan);
fv:=frac(vichitan);
 
cu:=trunc(umnogen);
fu:=frac(umnogen);
 
 
cd:=trunc(delen);
fd:=frac(delen);
 
 
 
{c:=trunc(n);
f:=frac(n);}
 
writeln('      в 8-ричной системе сумма =  ',DecToOctTrunc(cs),DecToOctFrac(fs,t));
writeln('      в 8-ричной системе разность =  ',DecToOctTrunc(cv),DecToOctFrac(fv,t));
writeln('      в 8-ричной системе умножение =  ',DecToOctTrunc(cu),DecToOctFrac(fu,t));
writeln('      в 8-ричной системе деление =  ',DecToOctTrunc(cd),DecToOctFrac(fd,t));
readln
end
 
    else
    { иначе сообщаем об ошибке }
    WriteLn('ERROR');
 
 
  { Ждем, когда пользователь нажмет [Enter] }
  ReadLn;
end.

Новые блоги и статьи Все статьи Все блоги /
http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит переходные токи и напряжения на элементах схемы. . . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

@Mikel23 0 / 0 / 0 Регистрация: 04.05.2010 Сообщений: 5
	07.05.2010, 09:17 [ТС]
	Я тоже так побывал так не получается. Я по этому и помощи попросил... 0