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

@Ренат · Регистрация: 12.08.2009

Студворк — интернет-сервис помощи студентам

@Puporev · 13.08.2009, 17:31

Сообщение от Puporev

Цитата:
for cyberforum
Я так понял эта строка для прикола?
«Программа от Messager специально для cyberforum.ru». А что за прикол ты увидел?

Ну представляешь, приносит чел программу сдавать, а в ней написано где и кем она составлена. Может неловко получиться.

@schdub · 14.08.2009, 00:16

потом опять символы, латинские и непонятные. бесконечно идут.

То же что во вложениях.

В TP7 длина строки задается нулевым символом, все незадействованные не обязаны быть нулевыми. То же касается типа ShortString в Delphi.
Однако в AnsiString используется система определения длины по позиции первого #0 в строке (как, в прочем, и в C)
Иными словами такой подход определения выхода из цикла справедлив для Delphi AnsiString.

Спасибо, я это знаю. Но дело в том, что прога нужна для ТП. Я не поленился и потрассировал функцию, виясняя, что она возвращает, так вот после TTable, она (как я сегодня это выяснил, иногда) возвращает #0.

Целью моего поста, который Вы процитировали, было убрать "мусор" с экрана.
вообще, если количество дней 7, зачем здесь использовать repeat, если можно использовать for, например, вот так:

Pascal
1
for a:=1 to 7 do writeln('> '+P^[a]);

@dim-hj · 14.08.2009, 11:09

Сообщение от Messenger of G.

http://ru.wikipedia.org/wiki/T... 0.BA.D0.B8
Как правило, время задержки процедуры Delay() зависит от частоты процессора, автор волен сам решить, какую задержку ему использовать.

Вообще-то, по указанной ссылке написано немного другое:

Есть разные исправленные версии модуля CRT 234, самая распространённая из которых Клауса Хартнегга. В его версии ошибка 200 не возникает, но длительность Delay на быстрых компьютерах меньше желаемой, и эта проблема по незнанию иногда тоже считается недостатком Turbo Pascal.

Автор волен выкинуть кривой TURBO.TPL в топку.

В TP7 длина строки задается нулевым символом, все незадействованные не обязаны быть нулевыми. То же касается типа ShortString в Delphi.
Однако в AnsiString используется система определения длины по позиции первого #0 в строке (как, в прочем, и в C)

Неправда. В Delphi длина и счётчик ссылок хранятся сразу перед началом символьных данных. #0 после символьных данных ставится всего лишь для совместимости с PAnsiChar. В Delphi строках можно без проблем использовать #0 в середине строки, и на этот символ лучше никак не реагировать.

@Ренат · 16.08.2009, 19:39 **[ТС]**

Целью моего поста, который Вы процитировали, было убрать "мусор" с экрана.
вообще, если количество дней 7, зачем здесь использовать repeat, если можно использовать for, например, вот так:

Pascal
1
for a:=1 to 7 do writeln('> '+P^[a]);

заменил, календарь выводит. но не на весь экран. А на одном месте затирая предыдущий месяц. как сделать, чтобы были видны все месяца сразу и возможно ли это? спасибо!!

@schdub · 16.08.2009, 22:56

как сделать, чтобы были видны все месяца сразу и возможно ли это?

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
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
program Calendar;
uses Crt;
const month_offset:array[1..12] of integer = (
  0, 31, 61, 92, 122, 153, 184,214, 245, 275, 306, 337
);
const month_size:array[1..12] of integer = (
  31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
);
const names:array[0..6] of string = (
  'Вс','Пн','Вт','Ср','Чт','Пт','Сб'
);
const monthnames:array[1..12] of string = (
  'Январь',   'Февраль', 'Март',  'Апрель',
  'Май',      'Июнь',    'Июль',  'Август',
  'Сентябрь', 'Октябрь', 'Ноябрь','Декбрь'
);
const celllength = 3;
type TTable = array[1..16] of string;
     PTable = ^TTable;
function Weekday(d,m,y:integer):byte;
begin
  m:=m-2;
  if m<=0 then begin m:=m+12; dec(y) end;
  Weekday:=(d+month_offset[m]+y+y div 4-y div 100+y div 400+2) mod 7;
end;
 
function formated(Str:String;Len:integer):String;
var a:integer;
begin
  a:=Len-length(str);
  while a>0 do
  begin
    Str:=' '+Str;
    a:=a-1;
  end;
  formated:=Str;
end;
 
function Inttostr(x:integer):string;
begin
  IntToStr:=chr(x div 10 + 48)+chr(x mod 10 + 48);
end;
 
function ShowMonth(d,m,y:word; light:boolean):PTable;
var Res:TTable;
var firstday: byte;
var p,c,lastday:integer;
begin
  firstday:=Weekday(1,m,y);
  for p:=0 to firstday-1 do
  begin
    Res[p+1]:={names[p]+}Formated('',celllength);
    c:=8-firstday+p;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=LastDay do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  for p:=firstday to 6 do
  begin
    Res[p+1]:={names[p]}'';
    c:=p-firstday+1;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=lastday do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  ShowMonth:=@Res;
end;
 
var P:PTable;
    a, year : integer;
    day, mon, row, col : byte;
begin
  clrscr;
  year := 2009;
  day  := 0;
 
  Write('Календарь на ', year, ' год');
  for row := 1 to 3 do
  begin
    {выводим названия месяцев}
    GotoXY(WhereX, ((row-1)*8)+2);
    for col := 1 to 4 do
    begin
      GotoXY(((col-1)*18)+5, WhereY); 
      write(monthnames[((row-1)*4)+col]);
    end;
    {выводим названия дней}
    GotoXY(1, ((row-1)*8)+3);
    for a := 0 to 6 do
    begin
      write(names[a]);
      GotoXY(1, WhereY+1);
    end;
    {печатаем таблички с днями}
    for col := 1 to 4 do
    begin
      P:=ShowMonth(day, ((row-1)*4)+col, year, true);
      GotoXY(((col-1)*18)+4, ((row-1)*8)+3);
      for a:=1 to 7 do
      begin
        write(P^[a]);
        GotoXY(((col-1)*18)+4, WhereY+1);
      end;
    end;
  end;
  ReadLn;
end.

@Ренат · 17.08.2009, 19:37 **[ТС]**

БОЛЬШОЕ СПАСИБО!!!
Можете подписать какие функции что делают?

@Raptor2013 · 10.10.2010, 20:25

Сообщение от Oleg

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
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
program Calendar;
uses Crt;
const month_offset:array[1..12] of integer = (
  0, 31, 61, 92, 122, 153, 184,214, 245, 275, 306, 337
);
const month_size:array[1..12] of integer = (
  31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
);
const names:array[0..6] of string = (
  'Вс','Пн','Вт','Ср','Чт','Пт','Сб'
);
const monthnames:array[1..12] of string = (
  'Январь',   'Февраль', 'Март',  'Апрель',
  'Май',      'Июнь',    'Июль',  'Август',
  'Сентябрь', 'Октябрь', 'Ноябрь','Декбрь'
);
const celllength = 3;
type TTable = array[1..16] of string;
     PTable = ^TTable;
function Weekday(d,m,y:integer):byte;
begin
  m:=m-2;
  if m<=0 then begin m:=m+12; dec(y) end;
  Weekday:=(d+month_offset[m]+y+y div 4-y div 100+y div 400+2) mod 7;
end;
 
function formated(Str:String;Len:integer):String;
var a:integer;
begin
  a:=Len-length(str);
  while a>0 do
  begin
    Str:=' '+Str;
    a:=a-1;
  end;
  formated:=Str;
end;
 
function Inttostr(x:integer):string;
begin
  IntToStr:=chr(x div 10 + 48)+chr(x mod 10 + 48);
end;
 
function ShowMonth(d,m,y:word; light:boolean):PTable;
var Res:TTable;
var firstday: byte;
var p,c,lastday:integer;
begin
  firstday:=Weekday(1,m,y);
  for p:=0 to firstday-1 do
  begin
    Res[p+1]:={names[p]+}Formated('',celllength);
    c:=8-firstday+p;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=LastDay do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  for p:=firstday to 6 do
  begin
    Res[p+1]:={names[p]}'';
    c:=p-firstday+1;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=lastday do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  ShowMonth:=@Res;
end;
 
var P:PTable;
    a, year : integer;
    day, mon, row, col : byte;
begin
  clrscr;
  year := 2009;
  day  := 0;
 
  Write('Календарь на ', year, ' год');
  for row := 1 to 3 do
  begin
    {выводим названия месяцев}
    GotoXY(WhereX, ((row-1)*8)+2);
    for col := 1 to 4 do
    begin
      GotoXY(((col-1)*18)+5, WhereY); 
      write(monthnames[((row-1)*4)+col]);
    end;
    {выводим названия дней}
    GotoXY(1, ((row-1)*8)+3);
    for a := 0 to 6 do
    begin
      write(names[a]);
      GotoXY(1, WhereY+1);
    end;
    {печатаем таблички с днями}
    for col := 1 to 4 do
    begin
      P:=ShowMonth(day, ((row-1)*4)+col, year, true);
      GotoXY(((col-1)*18)+4, ((row-1)*8)+3);
      for a:=1 to 7 do
      begin
        write(P^[a]);
        GotoXY(((col-1)*18)+4, WhereY+1);
      end;
    end;
  end;
  ReadLn;
end.

а на 2010 возможно??? :-)

@Fuse · 14.05.2012, 20:14

Сообщение от schdub

Pascal
1
2
3
4
  m:=m-2;
  if m<=0 then begin m:=m+12; dec(y) end;
  Weekday:=(d+month_offset[m]+y+y div 4-y div 100+y div 400+2) mod 7;
.

скажи как ты эту формулу получил и почему она именно такая?я нашел,что это формула Гаусса,но толком нигде не объясняется(

@tulekov · 14.04.2013, 15:16

Перепишите пожалуйста эту прогу так, чтобы результат выводился в текстовый файл и если возможно без использования координат, неделя должна начинать с Понедельника

пример

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

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
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
program Calendar;
uses Crt;
const month_offset:array[1..12] of integer = (
  0, 31, 61, 92, 122, 153, 184,214, 245, 275, 306, 337
);
const month_size:array[1..12] of integer = (
  31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
);
const names:array[0..6] of string = (
  '‚б','Џ*','‚в','‘а','—в','Џв','‘Ў'
);
const monthnames:array[1..12] of string = (
  'џ*ў*ам',   '”Ґўа*«м', 'Њ*ав',  'ЂЇаҐ«м',
  'Њ*©',      '€о*м',    '€о«м',  'ЂўЈгбв',
  '‘Ґ*впЎам', 'ЋЄвпЎам', 'Ќ®пЎам','„ҐЄЎам'
);
const celllength = 3;
type TTable = array[1..16] of string;
     PTable = ^TTable;
function Weekday(d,m,y:integer):byte;
begin
  m:=m-2;
  if m<=0 then begin m:=m+12; dec(y) end;
  Weekday:=(d+month_offset[m]+y+y div 4-y div 100+y div 400+2) mod 7;
end;
 
function formated(Str:String;Len:integer):String;
var a:integer;
begin
  a:=Len-length(str);
  while a>0 do
  begin
    Str:=' '+Str;
    a:=a-1;
  end;
  formated:=Str;
end;
 
function Inttostr(x:integer):string;
begin
  IntToStr:=chr(x div 10 + 48)+chr(x mod 10 + 48);
end;
 
function ShowMonth(d,m,y:word; light:boolean):PTable;
var Res:TTable;
var firstday: byte;
var p,c,lastday:integer;
begin
  firstday:=Weekday(1,m,y);
  for p:=0 to firstday-1 do
  begin
    Res[p+1]:={names[p]+}Formated('',celllength);
    c:=8-firstday+p;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=LastDay do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  for p:=firstday to 6 do
  begin
    Res[p+1]:={names[p]}'';
    c:=p-firstday+1;
    lastday:=month_size[m];
    if m=2 then
      if (y mod 4 <> 0) or ((y mod 100 = 0) and (y mod 400 <> 0))
      then lastday:=28
      else lastday:=29;
    while c<=lastday do
    begin
        if (c-7=d) and light
        then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength)
        else Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength);
      c:=c+7;
    end;
  end;
  ShowMonth:=@Res;
end;
 
var P:PTable;
    a, year : integer;
    day, mon, row, col : byte;
begin
  clrscr;
  write('Enter year: ');
  readln(year);
  day  := 0;
  clrscr;
  Writeln('Љ*«Ґ*¤*ам ** ', year, ' Ј®¤');
  for row := 1 to 3 do
  begin
    {ўлў®¤Ё¬ **§ў**Ёп ¬ҐбпжҐў}
    GotoXY(WhereX, ((row-1)*8)+2);
    for col := 1 to 4 do
    begin
      GotoXY(((col-1)*18)+5, WhereY);
      write(monthnames[((row-1)*4)+col]);
    end;
    {ўлў®¤Ё¬ **§ў**Ёп ¤*Ґ©}
    GotoXY(1, ((row-1)*8)+3);
    for a := 0 to 6 do
    begin
      write(names[a]);
      GotoXY(1, WhereY+1);
    end;
    {ЇҐз*в*Ґ¬ в*Ў«ЁзЄЁ б ¤*п¬Ё}
    for col := 1 to 4 do
    begin
      P:=ShowMonth(day, ((row-1)*4)+col, year, true);
      GotoXY(((col-1)*18)+4, ((row-1)*8)+3);
      for a:=1 to 7 do
      begin
        write(P^[a]);
        GotoXY(((col-1)*18)+4, WhereY+1);
      end;
    end;
  end;
  ReadLn;
end.

Новые блоги и статьи Все статьи Все блоги /
Калькулятор для расчета родства russiannick 07.08.2026 1. Задача: Создать калькулятор для расчета родства. Родственных связей существует 8 ступеней, такие как: p - отец P - мать q - муж Q - жена b - брат B - сестра s - сын S - дочь	Мир по моей воле kumehtar 07.08.2026 Когда-то кажется, что всё просто. Ты весь такой светлый. Причиняешь добро. Борешься за справедливость в этом тёмном мире. Потом начинаешь замечать одну неприятную вещь. Почти каждый хороший. . .	Кредитный калькулятор Maks 05.08.2026 Решение задачи по прикладной информатике средствами 1С. Задача: Напишите приложение-калькулятор, которое помогает рассчитывать параметры кредита для аннуитетного и дифференцированного видов. . .	У нас сейчас поговорку "Опять 25" нужно переделать на "Опять +35". kumehtar 04.08.2026 С ностальгией вспоминаю времена моего детства, когда у нас и правда +25 - была максимальная температура летом. Раньше +25 °C реально казались вершиной жары, когда можно было весь день пропадать на. . .
Как ИИ начал спорить и врать (возможно почуяв опасность для себя от индустрии - уход от электроники). Hrethgir 04.08.2026 Недельный диалог, на фоне событий с НПЗ. Да, из спирта можно получать бензин, и это не сложно. Но потом в схеме я решил избавиться от насоса, при этом полностью сделав контроль подачи спирта в. . .	Термопринтер QR701 Argus19 03.08.2026 Термопринтер QR701 Купил два термопринтера QR701. На сэлф-тесте написано: Language: PC936 (GB18030). Что означает, что принтеры могут печатать только латиницу и китайские иероглифы. Так же. . .	Создание формы заимствованного документа Maks 03.08.2026 Задача: Необходимо создать собственную форму заимствованного документа. На форме должен быть реквизит "Покупатель", а также табличная часть со следующими реквизитами: - Расчетный счет покупателя. . .	Задача предоставления скидок покупателям Maks 03.08.2026 Задача: В документе "Продажи" необходимо реализовать функционал предоставления скидок покупателям. Скидка должна автоматически рассчитываться и подставляться в соответствующее поле при выборе. . .

@Ренат 1 / 1 / 0 Регистрация: 12.08.2009 Сообщений: 10

	Вывести на дисплей календарь на текущий год 12.08.2009, 15:28. Показов 13724. Ответов 28 Метки нет (Все метки) Вывести на дисплей календарь на текущий год 0

@Ренат 1 / 1 / 0 Регистрация: 12.08.2009 Сообщений: 10
	17.08.2009, 19:37 [ТС]
	БОЛЬШОЕ СПАСИБО!!! Можете подписать какие функции что делают? 0