С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
Free Pascal
Войти
Регистрация
Восстановить пароль
 
Rufousfox
0 / 0 / 2
Регистрация: 10.09.2016
Сообщений: 9
1

Вывести календарь на экран

08.02.2017, 22:23. Просмотров 273. Ответов 2

Снова к вам!

Задача: Вывод двенадцати месяцев на одном экране, начиная с заданного месяца.

Получилось вот что:
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
Program TestC;
Uses Crt;
var
  I,J,Q,R,C: integer;
  Mo,Yr: integer;
  M: array [1..4,1..3,1..7,1..6] of integer;         {2.ЋЎкпў«Ґ*ЁҐ ¬*ббЁў* 7е6}
  p: integer;
const
    WDay: array[1..7]  of string=('Mon ', 'Tue ', 'Wed ', 'Thu ', 'Fr  ', 'Sat ', 'Sun ');   {8.„®Ў*ўЁвм **§ў**Ёп ¤*Ґ© *Ґ¤Ґ«Ё}
    MaxD: array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31); {10.„®Ў*ўЁвм ¬*Єб зЁб«® ¤*Ґ© ў ¬ҐбпжҐ}
    MoName: array[1..12] of string=('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
 
function DayWeek (Day, Month, Year: integer): byte;
var
  DaysInYears, AllDays, DaysInMonths, Weeks: longint;
begin
  if Month < 3 then begin
    Month := Month+12;
    Year  := Year-1;
  end;
  Month := Month+1;
  DaysInMonths := trunc(Month*30.6);
  DaysInYears  := trunc(Year*365.25);
  AllDays      := DaysInMonths+DaysInYears+Day-114;
  Weeks        := AllDays div 7;
  DayWeek      := AllDays - Weeks*7;
  if DayWeek=0 then DayWeek:=7;
end;
 
begin
Clrscr;
  Writeln('Enter month, year: ');           {9.‚ў®¤ *®¬Ґа®ў ¬Ґбпж* Ё Ј®¤*}
  Read(Mo,Yr);
Clrscr;
  for I:=1 to 4 do                        {3.‡*Ї®«*Ё«Ё ¬*ббЁў *г«п¬Ё}
   for J:=1 to 3 do begin
    for R:=1 to 7 do
     for C:=1 to 6 do
       M[I,J,R,C]:=0;                         {4.‚лў®¤ ¬*ббЁў* *г«Ґ©}
   //for I:=1 to 7 do begin
     //DayWeek(I,2,2017), ' ');          {1. ‚맮ў дг*ЄжЁЁ DayW}
    //for J:=1 to 6 do begin
      //M[I,J]:=D; Write(M[I,J]); end;
    //Writeln;
   //end;
 
    P:=DayWeek(1,Mo,Yr);                    {5.®ЇаҐ¤Ґ«Ё«Ё *®¬Ґа ап¤* 1-Ј® зЁб«* ¬Ґбпж*}
    R:=P;
    C:=1;
  if (Yr mod 4=0) and (Yr mod 100<>0) then MaxD[2]:=29;     {11. „®Ў*ўЁ«Ё гзҐв ўЁб®Є®б*®Ј® Ј®¤*}
  for Q:=1 to MaxD[Mo] do begin                   {6.а*бЇ®«®¦Ґ*ЁҐ *®¬Ґа®ў ¤*Ґ© ¬Ґбпж* ў ¬*ббЁўҐ}
      if (R > 7) then begin
        Inc(C);
        R:=1;
       end;
     M[I,J,R,C]:=Q;
     Inc(R);
  end;
  end;
  for I:=1 to 4 do begin
   for R:=1 to 7 do begin
    for J:=1 to 3 do begin
      if R=1 then begin
        TextColor(LightGreen);
        Writeln('      ', MoName[Mo]);                  {12.‚лў®¤ **§ў**Ёп ¬Ґбпж*}
        TextColor(White);
        if Mo=12 then begin
          Mo:=0;
          Inc(Yr);
        end;
        Inc(Mo);
      end
      else begin
       Write(WDay[R]);
 
       for C:=1 to 6 do
         if M[I,J,R,C]<>0 then begin
           if R=7 then TextColor(LightRed);          {17.1 ‚뤥«Ё«Ё ў®бЄаҐбҐ*мп Єа 梥⮬}
             Write(' ', M[I,J,R,C]);    {7.ўлўҐбвЁ ¬*ббЁў ¤*Ґ© ¬Ґбпж*}
         end
         else Write (' ',' ');
 
      end;
      Writeln;
    end;
   TextColor(White);
   Writeln;
   end;
  Writeln;
  end;
Readln;
end.
Выходит черте что! Помогите разобраться??
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
08.02.2017, 22:23
Ответы с готовыми решениями:

Вывести на дисплей календарь на текущий год
Используя оператор for надо Вывести на дисплей календарь на текущий год

Найти максимальное слово и вывести его на экран, если максимальных слов несколько, то вывести все
1. Найти максимальное слово и вывести его на экран, если максимальных слов...

Сгенерировать и вывести на экран массив с 10 случайных чисел в диапазоне от -100 до 100. Цикличный сдвиг массива влево на 1 и вывод на экран
Помогите написать программку в Паскале, что сгенерирует и выведет на экран...

Задать матрицу из целых чисел 3х4, вывести на экран, найти максим четный элемент и минимальный нечетный , поменять их местами, вывести новую матрицу
Задать матрицу из целых чисел 3х4, вывести на экран, найти максим четный...

Вывести на экран числа
Помогите пожалуйста решить задачу, добрые люди! Решить задачу с...

2
Joy
Эксперт Pascal/Delphi
2177 / 1203 / 1439
Регистрация: 29.08.2014
Сообщений: 4,389
09.02.2017, 10:17 2
как-то так у меня вышло:
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
uses Crt;
var
  a,y,m,d,i,j,k,t:integer;
  vg:boolean;
  dx,dy,ny:integer;
begin
  window(1,1,80,43);
  clrscr;
  write('Enter Month Year(01 2017):');readln(m,y);
  j:=m;
  dx:=1;
  dy:=2;
  repeat
    vg:=(y mod 4=0) and ((y mod 100<>0) or (y mod 400=0));
    a:=(14-j) div 12;
    k:=y-a;
    t:=j+12*a-2;
    d:=(7000+(1+k+k div 4-k div 100+k div 400+(31 * t) div 12)) mod 7;
    window(dx,dy,dx+20,dy+8);textbackground(LightBlue+j mod 2+2*ny);clrscr;
    textcolor(Yellow);
    if j<10 then write('0');write(j);textcolor(LightRed);writeln(' ',y);
    textcolor(lightgray);
    writeln(' Su Mo Tu We Th Fr Sa');
    if d>0 then gotoxy(d*3,3);
    if j in [1,3,5,7,8,10,12] then t:=31;
    if j in [4,6,9,11] then t:=30;
    if j=2 then if vg then t:=29 else t:=28;
    for i:=1 to t do write(i:3);
    j:=j+1;
    dx:=dx+23;
    if j=13 then begin j:=1;y:=y+1;ny:=1;dy:=dy+8;end;
    if dx>65 then begin dx:=1;dy:=dy+8;end;
  until j=m;
  readln;
end.
1
Rufousfox
0 / 0 / 2
Регистрация: 10.09.2016
Сообщений: 9
09.02.2017, 16:28  [ТС] 3
Спасибо! Очень здорово вышло.
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.02.2017, 16:28

не могу вывести на экран
не могу вывести на экран результат &quot;s&quot;...исправте пожалуста мои ошибки ...

Вывести на экран значения х, y
Вывести на экран значения х, y и функции z ( x , y )= y + sin ( x^2) в виде...

Вывести результат на экран
Ребята, помогите разобраться, вот задание: 1) Постановка задачи;...


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

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

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