Главная » Исходники » Разное » Старояпонский календарь

Старояпонский календарь

Дата добавления: 22.10.2008


Программу выводит название года по старояпонскому календарю.

В старояпонском календаре был принят 60-летний цикл, состоявший из пяти 12-летних подциклов. Подциклы обозначались названиями цвета: green (зеленый), red (красный), yellow (желтый), white (белый) и black (черный). Внутри каждого подцикла годы носили названия животных: крысы, коровы, тигра, зайца, дракона, змеи, лошади, овцы, обезьяны, курицы, собаки и свиньи. (1984 год – год зеленой крысы – был началом очередного цикла).

Скачиваний: 1501 | Просмотров: 9242 | Комментариев: 8 | Рейтинг материала: 3.5
Автор:
Рейтинг: 3.5/12 |

Скачать [36.6Kb]

0   Спам
(02.05.2013)
6. Вот код Pascal
program Kalendar;
var
a,b,c,d:integer;
begin
writeln('Введите год');
readln(a);
if a > 1983 then begin
while a>1983 do
a:=a-60;
b:=a-1923;
end
else begin
while a<193 do
a:=a+60;
b:=a-1983;
end;
c:=(b div 12)+1;
d:=b mod 12;
case c of
1: write('Зеленый ');
2: write('Крастный ');
3: write('Желтый ');
4: write('Белый ');
5: write('Черный ');

end;
case d of
1: write('Крыса');
2: write('Бык');
3: write('Тигр ');
4: write('Заяц ');
5: write('Дракон ');
6: write('Змея ');
7: write('Лошадь ');
8: write('Овца ');
9: write('Обезьяна ');
10: write('Петух ');
11: write('Собака ');
0: write('Кабан ');
end;

end.

0   Спам
(06.11.2012)
5. Дарья
Вот такое решение получилось у меня:)

program qq;
uses CRT;
var n, a, b, c: integer;
begin
readln(n);
c:= n mod 5;
case c of
4: writeln('green');
0: writeln('red');
1: writeln('yellow');
2: writeln('white');
3: writeln('black');
end;
b:=n mod 12;
case b of
3: writeln('pig');
4: writeln('mouse');
5: writeln('cow');
6: writeln('tiger');
7: writeln('rabbit');
8: writeln('dragon');
9: writeln('snake');
10: writeln('hourse');
11: writeln('sheep');
0: writeln('monkey');
1: writeln('bird');
2: writeln('dog');
end;
end.

0   Спам
(07.12.2011)
4. Александр
у меня код немного полегче))) В школе задавали.
uses crt;
var a,g,b:integer;
begin
repeat
clrscr;
textcolor(yellow);
writeln('ўўҐ¤ЁвҐ Ј®¤');
readln(g);
b:=g mod 60;
textcolor(green);
case b of
1..12: write('зелёный');
13..24: write('красный');
25..36: write('желтый');
37..48: write('белый');
49..59,0: write('чёрный');
end;
case b of
4,16,28,40,52: write(' крыса ');
5,17,29,41,53: write(' корова ');
6,18,30,42,54: write(' тигр');
7,19,31,43,55: write(' заяц');
8,20,32,44,56: write(' дракон­');
9,21,33,45,57: write(' змея');
10,22,34,46,58: write(' лошадь');
11,23,35,47,59: write(' овца ');
12,24,36,48,0: write(' обезьяна­ ');
13,25,37,49,1: write(' петух');
14,26,38,50,2: write(' собака ');
15,27,39,51,3: write(' свинья');
end;
readln;
textcolor(red);
writeln('чтоб завершить программу введите 3');
readln(a);
until a=3;
end.

0   Спам
(19.08.2011)
3. Ravie
Действительно цвета не верные... Если кому надо, я доработала код. В моем варианте вроде все как надо...

uses
Windows, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, jpeg, ShellAPI, DateUtils;

...

var
Form1: TForm1;
mas1: array [0..4] of string = ('бел', 'чёрн', 'зелён', 'красн', 'жёлт');
mas2: array [0..11] of string = ('крысы', 'быка', 'тигра', 'кролика', 'дракона', 'змеи', 'лошади', 'овцы', 'обезьяны', 'петуха', 'собаки', 'свиньи');
mas3: array [0..11] of string = ('ой', 'ого', 'ого', 'ого', 'ого', 'ой', 'ой', 'ой', 'ой', 'ого', 'ой', 'ой');

....

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text:=IntToStr(YearOf(Today));
Edit1.SelectAll;
Edit1Change(Sender);
end;

procedure TForm1.Edit1Change(Sender: TObject);
var x,x2:integer;
begin
if Edit1.Text<>'' then begin
x2 := StrToInt(Edit1.Text);
x := x2-1984;
if x >= 0 then begin
while x >= 12 do x := x-12;
end else begin
while x < -12 do x := x+12;
x := -12-x;
end;

x2 := x2 mod 10;
x2 := x2 div 2;
if abs(x) = 12 then x := 1;
Label2.Caption := 'Год '+mas1[abs(x2)]+mas3[abs(x)]+' '+mas2[abs(x)];
end;
end;

0   Спам
(13.07.2011)
2. Кирилл
1983 - год черной свиньи( ваша программа говорит, что год зеленой свиньи)

+1   Спам
(22.10.2008)
1. Администратор (Admin)
Делал в институте на лабораторной работе.


Имя *:
Email:


Код *:


Самая подробная информация массаж лингама цена у нас на сайте.

Copyright © 2008 - 2018 Программирование на Delphi для начинающих и не только.

Полнота авторских прав на все материалы, опубликованные на сервере DelphiDevelop.ru принадлежит их авторам.

Перепечатка материалов разрешается с указанием авторства и гиперссылки на первоисточник информации.