Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
daddymushrooms
2 / 2 / 4
Регистрация: 20.02.2014
Сообщений: 38
#1

Переписать программу под перевод 3-ых действительных чисел в 10-ую СС - Delphi

28.05.2014, 12:48. Просмотров 305. Ответов 2
Метки нет (Все метки)

Добрый день, помогите пожалуйста. Проблема следующая. В программе ниже представлена программа по переводу 5-ых действительных чисел в 10-ую систему счисления. Как переписать эту программу под перевод 3-ых действительных чисел в 10-ую ??
Delphi
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
         program FiveToDec;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows,
  Math;
 
 
function ToDecIntPart(value:String):Real;
var
  i, dec: Integer;
  pow: Real;
begin
  dec:=0;
 
  for i := 1 to Length(value) do begin
    pow := StrToInt(value[i]) * Power(5, (Length(value) - i));
    dec := dec + Trunc(pow);
  end;
 
  ToDecIntPart := dec;
end;
 
function ToDecDecimalPart(value:String):Real;
var
  i: Integer;
  pow, dec: Real;
 
begin
  dec:=0;
 
  for i := 1 to Length(value) do begin
    pow := StrToInt(value[i]) * Power(5, i*(-1));
    dec := dec + pow;
  end;
 
  ToDecDecimalPart := dec;
end;
 
function ToDec(value:String):Real;
var
  dec:Real;
  sepPos: Integer;
  isPositive: Boolean;
begin
  isPositive := true;
  if (value[1] = '-') then begin
    value := Copy(value, 2, Length(value));
    isPositive := false;
  end;
 
  sepPos := Pos(DecimalSeparator, value);
  if (Length(Copy(value, 1, sepPos-1)) > 0) then begin
    dec := ToDecIntPart(Copy(value, 1, sepPos-1));
  end else begin
    dec := ToDecIntPart(value);
  end;
 
  if (sepPos > 0) then begin
    dec := dec + ToDecDecimalPart(Copy(value, sepPos+1, Length(value)));
  end;
 
  if (isPositive = false) then
    dec := dec * (-1);
 
  ToDec := dec;
end;
 
function checkErrorEmpty(value:String): Boolean;
begin
 if (length(value) < 1) then begin
    Writeln('   Ошибка ввода: Ничего не введено');
    checkErrorEmpty := true;
  end else begin
    checkErrorEmpty := false;
  end;
end;
 
function checkErrorCharacters(value:String):Boolean;
var
  isDecimalPart: Boolean;
  i: Integer;
begin
 
  if (((Ord(value[1]) < 48) OR (Ord(value[1]) > 52)) AND (value[1] <> '-')) then begin
    Writeln('   Ошибка ввода исходного числа: позиция номер 1');
    checkErrorCharacters := true;
  end else begin
 
    isDecimalPart := false;
    checkErrorCharacters := false;
 
    for i:= 2 to Length(value) do begin
      if (((Ord(value[i]) < 48) OR (Ord(value[i]) > 52)) AND (value[i] <> '.')) then begin
          Writeln('   Ошибка ввода исходного числа: позиция номер ',i);
          checkErrorCharacters := true;
          Break;
      end;
 
      if (value[i] = '.') then begin
        if (isDecimalPart = false) then begin
          isDecimalPart := true;
          Continue;
        end else begin
          Writeln('   Ошибка ввода исходного числа: позиция номер ',i);
          checkErrorCharacters := true;
          Break;
        end;
      end;
    end;
  end;
end;
 
function checkErrors(value:String):Boolean;
var
  isError: Boolean;
begin
  isError := checkErrorEmpty(value);
 
  if (isError = false) then
    isError := checkErrorCharacters(value);
 
  checkErrors := isError;
end;
 
procedure InputValue(var value:String; var hasError:Boolean);
begin
  Write('   Ввевдите действительное 5-ичное число: ');
  Readln(value);
  Writeln('//-----------------------------------------------------------------------------');
 
  hasError := checkErrors(value);
end;
 
procedure OutputResult(val:String; dec: Real; hasError:Boolean);
begin
  if (hasError = false) then
    Writeln('   10-ое представление: ', FloatToStr(dec), '  пятеричного числа: ',val);
 
  Writeln('//-----------------------------------------------------------------------------');
end;
 
var
  val: String;
  error: Boolean;
  result: Real = 0.0;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  DecimalSeparator := '.';
 
  Writeln('//-----------------------------------------------------------------------------');
  Writeln('   Приложение для перевода 5-ых действительных чисел в 10-ую систему счисления');
  Writeln('//-----------------------------------------------------------------------------');
 
  InputValue(val, error);
 
  if (error = false) then
    result := ToDec(val);
 
  OutputResult(val, result, error);
 
  Readln;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
28.05.2014, 12:48
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Переписать программу под перевод 3-ых действительных чисел в 10-ую СС (Delphi):

Написать программу перевода действительных чисел из любой системы счисления в десятичную и обратно
12366

Целую частьиз массива действительных чисел переписать в массив целых чисел
Использовать два одномерных массива - массив целых чисел и массив...

Создать файл действительных чисел и переписать его компоненты в обратном порядке
Создать файл действительных чисел и переписать его компоненты в обратном...

С++ Создать файл действительных чисел и переписать его компоненты в обратном порядке
Даже нет идей(

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

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

2
Puporev
Модератор
54148 / 41781 / 28887
Регистрация: 18.05.2008
Сообщений: 98,330
28.05.2014, 14:17 #2
Delphi
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
program FiveToDec;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows,
  Math;
 
function ToDecIntPart(value:String):Real;
var i, dec: Integer;
    pow: Real;
begin
dec:=0;
for i := 1 to Length(value) do
 begin
  pow := StrToInt(value[i]) * Power(3, (Length(value) - i));
  dec := dec + Trunc(pow);
 end;
result := dec;
end;
 
function ToDecDecimalPart(value:String):Real;
var i: Integer;
    pow, dec: Real;
begin
dec:=0;
for i := 1 to Length(value) do
 begin
  pow := StrToInt(value[i]) * Power(3, i*(-1));
  dec := dec + pow;
 end;
result := dec;
end;
 
function ToDec(value:String):Real;
var dec:Real;
    sepPos: Integer;
    isPositive: Boolean;
begin
isPositive := true;
if (value[1] = '-') then
 begin
  value := Copy(value, 2, Length(value));
  isPositive := false;
 end;
sepPos := Pos(DecimalSeparator, value);
if (Length(Copy(value, 1, sepPos-1)) > 0) then
dec := ToDecIntPart(Copy(value, 1, sepPos-1))
else dec := ToDecIntPart(value);
if (sepPos > 0) then
dec := dec + ToDecDecimalPart(Copy(value, sepPos+1, Length(value)));
if (isPositive = false) then dec := dec * (-1);
result := dec;
end;
 
function checkErrorEmpty(value:String): Boolean;
begin
if (length(value) < 1) then
 begin
  Writeln('   Ошибка ввода: Ничего не введено');
  result := true;
 end
else  result := false;
end;
 
function checkErrorCharacters(value:String):Boolean;
var isDecimalPart: Boolean;
    i: Integer;
begin
if (((Ord(value[1]) < 48) OR (Ord(value[1]) > 50)) AND (value[1] <> '-')) then
 begin
  Writeln('   Ошибка ввода исходного числа: позиция номер 1');
  result := true;
  end
else
 begin
  isDecimalPart := false;
  result := false;
  for i:= 2 to Length(value) do
   begin
    if (((Ord(value[i]) < 48) OR (Ord(value[i]) > 50)) AND (value[i] <> '.')) then begin
    Writeln('   Ошибка ввода исходного числа: позиция номер ',i);
    result := true;
    Break;
   end;
  if (value[i] = '.') then
   begin
    if (isDecimalPart = false) then
     begin
      isDecimalPart := true;
      Continue;
     end
    else
     begin
      Writeln('   Ошибка ввода исходного числа: позиция номер ',i);
      result := true;
      Break;
     end;
   end;
  end;
 end;
end;
 
function checkErrors(value:String):Boolean;
var isError: Boolean;
begin
isError := checkErrorEmpty(value);
if (isError = false) then
isError := checkErrorCharacters(value);
result := isError;
end;
 
procedure InputValue(var value:String; var hasError:Boolean);
begin
Write('   Введите действительное 3-ичное число: ');
Readln(value);
Writeln('//-----------------------------------------------------------------------------');
hasError := checkErrors(value);
end;
 
procedure OutputResult(val:String; dec: Real; hasError:Boolean);
begin
if (hasError = false) then
Writeln('   10-ое представление: ', FloatToStr(dec), '  троичного числа: ',val);
Writeln('//-----------------------------------------------------------------------------');
end;
 
var val: String;
    error: Boolean;
    result: Real = 0.0;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
DecimalSeparator := '.';
Writeln('//-----------------------------------------------------------------------------');
Writeln('   Приложение для перевода 3-ых действительных чисел в 10-ую систему счисления');
Writeln('//-----------------------------------------------------------------------------');
InputValue(val, error);
if (error = false) then result := ToDec(val);
OutputResult(val, result, error);
Readln;
end.
1
daddymushrooms
2 / 2 / 4
Регистрация: 20.02.2014
Сообщений: 38
28.05.2014, 14:22  [ТС] #3
Большое спасибо!
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
28.05.2014, 14:22
Привет! Вот еще темы с решениями:

Дано 8 действительных чисел. Вычислить сумму квадратов разностей корней из модулей действительных чисел
Дано 8 действительных чисел. Вычислить сумму квадратов разностей корней из...

Программу pascal переписать под c++
Всем доброго времени суток, прошу помощи у вас по скольку слабо разбераюсь в...

Переписать программу под модуль
как переделать данную программу при помощи модуля????? Program par; ...

Переписать программу под linux
переделать помощью mutex... #include &lt;stdio.h&gt; #include &lt;windows.h&gt; ...


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

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

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