IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Системы счисления и точность
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Антон

Репутация: -  0  +


Исходник перевода чисел от 2 до 16 систем счисления.
Подскажите как вырезать задавание точности и блок схему, в сих схемах, как и в паскале, чайник(((

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© * -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.


P.S. Как выдачу результата бегущей строкой сделать???

Сообщение отредактировано: Анарх -


--------------------
Делай как надо и будь что будет.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Анарх @ 29.07.2011 5:39) *
Подскажите как вырезать задавание точности и блок схему
Вырезать задание точности очень просто: убрать приглашение на ввод точности, убрать сам ее ввод, а вместо всего этого сделать: t:=255; - тогда точность всегда будет мамксимальной. Как вырезать блок-схему - извини, не знаю, не проходил.. )) А если серьезно, то тут вряд ли кто будет заниматься таким идиотизмом, как составление б-с после написания программы (да еще по чужому коду). Есть программы, которые это делают - найди и нарисуй..

Цитата
P.S. Как выдачу результата бегущей строкой сделать???
Поищи по форуму на такой семпл: +бегущ* +строк*


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Антон

Репутация: -  0  +


Uses
CRT;

const
a: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {задаём строку для поиска
в ней символов}
var
rez, s, s2, s3: string;
t, cc, ind, cc2, k,i,temp: 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© * -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
t:=5;
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;
temp := length(rez);
Repeat
If Length(rez) = 80 then
begin
For i:=80 downto temp+1 do
begin
delete(rez,1,1);
clrscr;
write(rez);
sleep(100);
end;
end
else
begin
For i:=length(rez) to 79 do
begin
clrscr;
rez:=' '+rez;
write(rez);
sleep(100);
end;
end;
Until (1<0)
end.


Так корректно написано???

Народ, нарисуйте блок схему, пожалуйста!
Я в них разобраться не успел!


--------------------
Делай как надо и будь что будет.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Анарх @ 30.07.2011 4:55) *
Так корректно написано???
Замени sleep на delay - и будет тебе щасье.. И еще рекомендую ХОТЯ БЫ вместо (1<0) написать keypressed - тогда хоть какой-то выход будет, помимо ctrl-c.

А вообще, вся тема - это образец того, как НЕ НАДО писать программы. Найти где-то какой-то код, попросить помочь его перекорячить и приписать к нему непонятную примочку.. И это, по-твоему, называется "делать, как надо"? Стер бы хотя бы подпись и не позорился..

Цитата
Народ, нарисуйте блок схему, пожалуйста!
Я в них разобраться не успел!
Не успел? Опоздал..
Тебя в Гугле забанили? Сказал же тебе: найди программу, рисующую блок-схемы. Пойми (для своего же блага) - никто не станет тратить время на то, что делается автоматически.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 10.05.2024 14:09
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name