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

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

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

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


Гость






Товарищи, выручайте! Есть такая задачка:
С клавы вводят число (n>0). Нужно создать программу, выводящую фразу:"...Эти порядки существовали n лет". n изменяется на год. года в соответствии с нормами русского языка. Заранее большое спасибо! mega_chok.gif

М
не надо постить свои вопросы в чужие темы !
klem4


М
to klem4: спасибо что не удалил просто... а то бы мне нечего вечермо делать было smile.gif
Altair

 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Ищущий истину
******

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

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



if n>0 then begin
if n>4 then writeln('...Эти порядки существовали ',n,' лет') else writeln('...Эти порядки существовали ',n,' года')
end else writeln('Enter n>0!!');


?

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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
***

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

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


Кажется имелось ввиду сообщение типа:
...Эти порядки существовали пять тысяч семисот лет


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


Ищущий истину
******

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

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


Цитата
Кажется имелось ввиду сообщение типа:
...Эти порядки существовали пять тысяч семисот лет

тогла я не вижу ограничение сверху
Цитата
С клавы вводят число (n>0)

как будешь описывать все описания для 1000000000000 например ?
это уже даже не миллиарды..


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Ищущий истину
******

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

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


Ну вот я покалякал...
работает с миллионами включая... если надо дальше то в прогу внести совсем немного добавления..

{$mode delphi}
uses STACK;
const

{t :array[1..9] of string = ('один',
'два',
'три',
'четыре',
'пять',
'шесть',
'семь',
'восемь',
'девять' );
}
t :array[1..9] of string = ('®¤Ё­',
'¤ў ',
'ваЁ',
'зҐвлаҐ',
'Їпвм',
'иҐбвм',
'ᥬм',
'ў®бҐ¬м',
'¤Ґўпвм' );
{
_sti='сти';
_sta='ста';
_sot='сот';
_sto='сто';
_dcat='дцать';
_sorok='сорок';
_des9t='десят';
_no='яно';
_tis9ch='тысяч';
_milliona='миллиона';
_ov='ов';
_a='а';
_i='и';
_mz='ь';
_nadzat='надцать' ;
}
_sti='бвЁ';
_sta='бв ';
_sot='б®в';
_sto='бв®';
_dcat='¤ж вм';
_sorok='б®а®Є';
_des9t='¤Ґбпв';
_no='п­®';
_tis9ch='влбпз';
_milliona='¬Ё««Ё®­ ';
_ov='®ў';
_a=' ';
_i='Ё';
_mz='м';
_nadzat='­ ¤ж вм';


function strtoint(s:string):integer;
var
r,code:integer;
begin
val(s,r,code);
strtoint:=r;
end;


procedure inttowords(N:integer);
var
ST: TSTACK;

procedure print3cintscack(s:string;r:integer);
var j:integer; res:string;
begin
res:='';
if s<>'' then begin
if s[1]<>'0' then begin
if strtoint(s[1])=1 then res:=_sto+' ';
if strtoint(s[1])=2 then res:=t[strtoint(s[1])]+_sti+' ';
if (strtoint(s[1])>=3) and (strtoint(s[1])<=4) then res:=t[strtoint(s[1])]+_sta+' ';
if strtoint(s[1])>=5 then res:=t[strtoint(s[1])]+_sot+' ';
end;
if s[2]<>'0' then begin
if (strtoint(s[2])=1) then begin
if s[3]='0' then res:=res+_des9t+_mz+' ';
if s[3]>='1' then begin
if s[3]='2' then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])])-1)+'e'+_nadzat+' '; {!!!!!!!!!e}
if s[3]='3' then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])]))+_nadzat+' ';
if (s[3]>='4') or (s[3]='1') then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])])-1)+_nadzat+' ';
end;
end;

if (strtoint(s[2])>=2) and (strtoint(s[2])<=3) then res:=res+t[strtoint(s[2])]+_dcat+' ';
if (strtoint(s[2])=4) then res:=res+_sorok+' ';
if (strtoint(s[2])>=5) and (strtoint(s[2])<9) then res:=res+t[strtoint(s[2])]+_des9t+' ';
if (strtoint(s[2])=9) then res:=res+ copy(t[strtoint(s[2])],1,3)+_no+_sto+' ';
end;
if (s[3]<>'0') and (s[2]<>'1') then res:=res+t[strtoint(s[3])];
case r of
2: begin
if s[3]='1' then begin res:=res+' '+_tis9ch+_a+' '; end;
if (s[3]>='2') and (s[3]<='4') then begin res:=res+' '+_tis9ch+_i+' '; end;
if s[3]>'4' then begin res:=res+' '+_tis9ch+' '; end;
end;

3: begin
if s[3]='1' then begin res:=res+' '+copy(_milliona,1,length(_milliona)-1)+' ' end;
if (s[3]>='2') and (s[3]<='4') then begin res:=res+' '+copy(_milliona,1,length(_milliona))+' ' end;
if (s[3]>'4') then begin res:=res+' '+copy(_milliona,1,length(_milliona)-1)+_ov+' ' end;
end;
end;
stackpush(st,res);
end;
end;
procedure printstack;
var
s:string;
begin
while not stackempty(ST) do begin
s:=stackpop(st);
write(s,' ');
end
end;

var
int:string;
i:integer;
r:integer;

begin
str(n,int);
StackInit(ST);
while length(int) mod 3 <>0 do int:='0'+int;
r:=1;
for i:=length(int)+1 div 3 downto 0 do begin
if copy(int,i*3+1,3)<>'' then print3cintscack(copy(int,i*3+1,3),r);
if copy(int,i*3+1,3)<>'' then inc®;
end;
printstack;
end;

var
n:integer;
begin
readln(n);
inttowords(n);
readln
end.


Константы записанны в кодировке DOS и WIN. (я с жтим мучался в FPC).
Компилятор FPC.
(должно и под TP пойти если первую директиву убрать)

скриншеты:
Прикрепленное изображение
Прикрепленное изображение
Прикрепленное изображение
Модуль stack отсюда (FAQ->ДСД, стек)

smile.gif Просьба обо всех замеченных ошибках сообщить. При желании исправить smile.gif

На всякий случай - скомпилированная программа с исходниками в архиве:Прикрепленный файл  inttowords.zip ( 12.78 килобайт ) Кол-во скачиваний: 414


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Perl. Just code it!
******

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

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


А что предела n не должно быть ? Я когда-то похожую задачу решал, но там до 1000. ссылка


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






smile.gif Спасибочки!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Ищущий истину
******

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

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


To: klem4
а что та твоя прога делает ?у меня все время 0 возвращает как рельузтат и все...
blink.gif
да и сразу вижу у нее проблеммы будут... не по русски выводить будет.
тома, всегда пожалуйста, только ты бы хоть сказал что тебе надо было smile.gif


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Perl. Just code it!
******

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

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


Олег, опять я с просони перепутал smile.gif) Там наоборот : Вводишь 'Сто двадцать пять'

получаешь результат : 125 ;)


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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