Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.65/57: Рейтинг темы: голосов - 57, средняя оценка - 4.65
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
1

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

12.08.2009, 15:28. Просмотров 10588. Ответов 28
Метки нет (Все метки)


Вывести на дисплей календарь на текущий год
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
12.08.2009, 15:28
Ответы с готовыми решениями:

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

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

Вывести на дисплей календарь на текущий год
1. Вывести на дисплей календарь на текущий год. 2.Составить программу для проверки...

Вывести на дисплей календарь на текущий год
Вывести на дисплей календарь на текущий год. Напишите формулу пожалуйста на qBasic

28
Модератор
62900 / 46930 / 32344
Регистрация: 18.05.2008
Сообщений: 113,713
12.08.2009, 15:32 2
Уточните задание. В каком виде вывести, приложите пример. В текстовом режиме на экран не войдет, наверное в графическом режиме нужно?
0
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
12.08.2009, 15:46  [ТС] 3
В задании больше ничего не указано. И примера нет никакого.
0
Эксперт по компьютерным сетямЭксперт Pascal/Delphi
4165 / 1272 / 229
Регистрация: 27.07.2009
Сообщений: 3,944
12.08.2009, 15:47 4
Цитата Сообщение от Puporev Посмотреть сообщение
В текстовом режиме на экран не войдет
почему не войдет? у меня входило. делал как-то такую программу.
0
2921 / 842 / 324
Регистрация: 30.04.2009
Сообщений: 2,633
12.08.2009, 15:47 5
ну а ты сам то как представляешь ????
0
Модератор
62900 / 46930 / 32344
Регистрация: 18.05.2008
Сообщений: 113,713
12.08.2009, 15:50 6
почему не войдет? у меня входило. делал как-то такую программу.
Да просто глянул на календарик, если разбить на 2 части, то все равно с учетом пробелов нужно в строке 90 позиций. По высоте вроде войдет.
1
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
12.08.2009, 16:01  [ТС] 7
я вообще не представляю, не помню

Добавлено через 8 минут 30 секунд
В каком направлении идти, через что?

Добавлено через 1 минуту 55 секунд
массив надо? вообще как?
0
Посланник моего господина
111 / 106 / 52
Регистрация: 02.05.2009
Сообщений: 181
12.08.2009, 19:39 8
На сайте acm.timus.ru была выложена похожая задача в качестве задания (ссылка)

Возможно использовать такой подход (точки можно заменить на пробелы, они использовались для отладки) :
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
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 = ('sun','mon','tue','wed','thu','fri','sat');
const monthnames:array[1..12] of string = ('january', 'february', 'march', 'april', 'may', 
     'june', 'july', 'august', 'september', 'october', 'november', 'december');
const celllength = 4;
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<>d) or not light
                                     then
                                         if (c-7=d) and light
                                            then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength-1)
                                            else 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<>d) or not light
                                     then
                                         if (c-7=d) and light
                                            then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength-1)
                                            else 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:integer;
var year : integer;
var day, mon : byte;
begin
clrscr;
writeln('> for cyberforum from messager. '); writeln;
write('> Enter a number of year: '); readln(year);
for mon:=1 to 12 do
    begin
    if keypressed then ReadKey;
    for day:=1 to 31 do
        begin
             P:=ShowMonth(day,mon,year,true);
             clrscr;
             writeln('>  ',monthnames[mon],' ',year);
             writeln;
             a:=0;
             repeat
                   a:=a+1;
                   if P^[a] <> '' then
                      writeln('> '+P^[a]);
             until P^[a] = '';
             if not keypressed then Delay(65535);
        end
    end
end.
Примечание: программа запрашивает у пользователя номер года и выводит календарь, проходя по всем дням поочередно. Обратите внимание на то, что можно выводить конкретную позицию (календарь для месяца с подсвеченным днём) при помощи функции ShowMonth(), вывод происходит в строках 94-102. Можно использовать другие способы вывода календаря на экран.
1
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
12.08.2009, 20:25  [ТС] 9
БОЛЬШОЕ СПАСИБО!!!!!!!
0
Модератор
62900 / 46930 / 32344
Регистрация: 18.05.2008
Сообщений: 113,713
12.08.2009, 22:30 10
writeln('> for cyberforum from messager. '); writeln;
Я так понял эта строка для прикола? Аффтар, выкинь!
if not keypressed then Delay(65535);
65535 это для какого-то кривого модуля *.TPL. До утра ждать надо. При нормальном модуле достаточно delay(400); или 0,4 сек.
Еще вроде память не освобождается и при повторном запуске программы выкидывает вместе с нужной информацией всякую хрень.
2
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
12.08.2009, 22:47  [ТС] 11
Благодарю!!!
0
Эксперт С++
3057 / 1399 / 421
Регистрация: 19.01.2009
Сообщений: 3,770
12.08.2009, 22:51 12
Цитата Сообщение от Puporev Посмотреть сообщение
Еще вроде память не освобождается и при повторном запуске программы выкидывает вместе с нужной информацией всякую хрень.
стр. 97-103

Индекс а выходил за границы массива, было выбрано неверное условие выхода из цикла.

нужно заменить на вот это
Pascal
1
2
3
4
5
6
7
       a:=1;
       repeat
         if P^[a] <> '' then
           writeln('> '+P^[a]);
         Inc(a);
       until P^[a][1] = #0;
       if not keypressed then Delay(4000);
1
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
12.08.2009, 22:57  [ТС] 13
спасибо!!!
0
Эксперт С++
3057 / 1399 / 421
Регистрация: 19.01.2009
Сообщений: 3,770
12.08.2009, 23:05 14
Ренат, Вы хоть пробовали компилировать программу Messenger'a?
Вам она подошла, или все же нужно переделывать?
0
Босс
161 / 126 / 10
Регистрация: 03.06.2009
Сообщений: 750
13.08.2009, 00:30 15
Вот, если интересно, мой личный(т.е. делал сам) календарь. делал года 2 назад. все нормально, считает и до нашей эры, только не учитывал особенность "которые делятся на 100, но не делятся на 400". Если кому надо - может исправить, мне лично - лень.
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
uses crt,graph,dos;
const bm:array[1..12]of string=('Janury','February','March','April','May',
'June','July','August','Septamber','October','November','December');
bn:array[1..7]of string=('mo','tu','we','th','fr','sa','su');
 
allx=33;
ally=80;
allintx=130;
allinty=16;
xd=390;
 
tx=220;
ty=38;
trn:array[1..6] of integer=(xd+tx,ty+1,xd+tx+15,ty+1,xd+tx+4,ty+17);
trv:array[1..6] of integer=(xd+tx,ty-1,xd+tx+15,ty-1,xd+tx+11,ty-17);
tx1=230;
ty1=42;
trl:array[1..6] of integer=(xd+tx1+1,ty1-6,xd+tx1-1,ty1+6,xd+tx1-13,ty1-1);
trr:array[1..6] of integer=(xd+2+tx1+1,ty1-6,xd+2+tx1-1,ty1+6,xd+2+tx1+13,ty1+1);
 
var era,god,mesats,nediela,den,denned,godnow,mesatsnow,dy,dg,dm,dd,x,y,z:integer;
cha: char;
 
procedure initialization; var gd,gm:integer; begin gd:=detect; initgraph(gd,gm,''); end;
 
function dnei(god,mesats:integer):integer;
begin
if mesats in [1,3,5,7,8,10,12] then dnei:=31;
if mesats in [4,6,9,11] then dnei:=30;
if (mesats=2)and ( (god mod 4=0) or((god mod 100=0)and(god mod 400=0))) then dnei:=29;
if (mesats=2)and ( (god mod 4<>0) or((god mod 100=0)and(god mod 400<>0))) then dnei:=28;
 
end;
 
procedure casem(m:integer);
begin case m of
1:begin x:=1;y:=1; end; 2: begin x:=1; y:=2; end; 3: begin x:=1; y:=3; end; 4: begin x:=2; y:=1; end; 5: begin x:=2; y:=2; end;
6:begin x:=2;y:=3; end; 7: begin x:=3; y:=1; end; 8: begin x:=3; y:=2; end; 9: begin x:=3; y:=3; end; 10:begin x:=4; y:=1; end;
11:begin x:=4; y:=2; end; 12:begin x:=4; y:=3; end; end; end;
 
function tex(a:integer):string; var t:string; begin str(a,t); tex:=t; end;
 
procedure wcalendar; begin {setcolor(10); settextstyle(1,0,7); outtextxy(280,-7,'Calendar');}
setcolor(9); settextstyle(2,0,4); outtextxy(540,464,'Sheikin Alexandr'); end;
 
 
procedure wgod(god:integer);
const xden=-140;
xmesats=-70;
xsec=5;
var t:string;
begin
if abs(den)<10 then t:='0'+tex(abs(den)) else t:=tex(abs(den));
setfillstyle(9,1);bar(xd+23+xden,20,xd+146+xden,57);setcolor(10);settextstyle(7,0,6);outtextxy(xd+25+xden,5,t);
outtextxy(xd+25+xden+57,5,'.');
if abs(mesats)<10 then t:='0'+tex(abs(mesats)) else t:=tex(abs(mesats));
setfillstyle(9,1);bar(xd+23+xmesats,20,xd+146+xmesats,57);setcolor(10);
settextstyle(7,0,6);outtextxy(xd+25+xmesats,5,t); outtextxy(xd+25+xmesats+55,5,'.');
 
setfillstyle(9,1);bar(xd+23,20,xd+146,57);setcolor(10);settextstyle(7,0,6);outtextxy(xd+25,5,tex(abs(god)));
setfillstyle(9,1);bar(xd+150,27,xd+216,57);
setcolor(10);settextstyle(7,0,5);
if era=-1 then outtextxy(xd+150,15,'B.C.');
if era=1 then outtextxy(xd+150,15,'A.D.');
end;
 
procedure data(var god,mesats,den:integer);
var year,m,day,d:word;
begin getdate(year,m,day,d);god:=year;mesats:=m;den:=day; end;
 
procedure chasi;
const xsec=5;
d=8;
var t:string;
hou,mi,se,sse:word;
hour,min,sec,ssec,dh,dm,ds,dss:integer;
begin
repeat
gettime(hou,mi,se,sse); hour:=hou;min:=mi;sec:=se; ssec:=sse;
 
if abs(sec)<10 then t:='0'+tex(abs(sec)) else t:=tex(abs(sec));
if (sec<>ds) then begin ds:=sec;
setfillstyle(9,1);bar(23+xsec+140-d-d,20+5,23+61+xsec+140-d-d,57);setcolor(10);settextstyle(7,0,5);
outtextxy(25+xsec+140-d-d,5+10,t);
end;
 
if abs(min)<10 then t:='0'+tex(abs(min)) else t:=tex(abs(min));
if (min<>dm) then begin dm:=min; setfillstyle(9,1);bar(23+xsec+70-d,20+5,23+61+xsec+70-d,57);
setcolor(10);settextstyle(7,0,5);outtextxy(25+xsec+70-d,5+10,t); outtextxy(25+xsec+70+57-d-d,5+10,':'); end;
 
if abs(hour)<10 then t:='0'+tex(abs(hour)) else t:=tex(abs(hour));
if (hour<>dh) then begin dh:=hour;
setfillstyle(9,1);bar(23+xsec,20+5,23+61+xsec,57);
setcolor(10);settextstyle(7,0,5);outtextxy(25+xsec,5+10,t); outtextxy(25+xsec+57-d,5+10,':');
end;
 
if (sec=00)and(min=00)and(hour=00) then begin
data(god,mesats,den); wgod(god); end;
until keypressed;
end;
 
 
procedure wmesats;
begin
for dm:=1 to 12 do begin casem(dm);
if (dm=mesatsnow)and(god=godnow) then setcolor(10) else setcolor(11);
settextstyle(5,0,2); outtextxy(allx+12+150*(x-1),ally+allintx*(y-1)-21,bm[dm]);
 
setcolor(14); settextstyle(2,0,4);
for dd:=1 to 6 do outtextxy(allx+22+150*(x-1)+(dd-1)*15,ally+25+allintx*(y-1)-allinty,bn[dd]);
setcolor(12); settextstyle(2,0,4);
dd:=7; outtextxy(allx+22+150*(x-1)+(dd-1)*15,ally+25+allintx*(y-1)-allinty,bn[dd]);
end;end;
 
 
procedure wnedela;               begin setcolor(14); settextstyle(2,0,4);nediela:=nediela+1;
if nediela<>0 then outtextxy(allx+150*(x-1),ally+25+allintx*(y-1)+dy*allinty,tex(nediela));end;
 
procedure wden;
var c:integer; begin c:=15;
if denned=7 then c:=12;
{if z=2 then c:=7;}
if (dd=den)and(dm=mesats)and(godnow=god)then c:=10;
setcolor(c); settextstyle(2,0,4);
outtextxy(allx+22+150*(x-1)+(denned-1)*15,ally+25+allintx*(y-1)+dy*allinty,tex(dd)); end;
 
 
procedure pisat(var god:integer;cha:char);
var d:integer; t:string;
begin
repeat
repeat
chasi;
cha:=readkey;
if cha=#0 then cha:=readkey;
until (cha=#8)or(cha=#13)or(cha=#27)or(cha=#115)or(cha=#116)or(cha=#75)or(cha=#77)or(cha=#72)or(cha=#80)
or(cha=#48)or(cha=#49)or(cha=#50)or(cha=#51)or(cha=#52)or(cha=#53)or(cha=#54)or(cha=#55)or(cha=#56)or(cha=#57);
 
case cha of
#72,#75: god:=god-1;
#80,#77: god:=god+1;
#115,#116: begin era:=-era; god:=-god; end;
end;
t:=tex(god);
 
if (cha=#48)or(cha=#49)or(cha=#50)or(cha=#51)or(cha=#52)or
(cha=#53)or(cha=#54)or(cha=#55)or(cha=#56)or(cha=#57)then begin
if length(t)<=4 then t:=t+cha;
if length(t)>4 then begin t:=''; t:=t+cha; end;
end;
if (cha=#8)and(length(t)>=1) then begin delete(t,length(t),1);end;
val(t,god,d);
wgod(god);
 
if cha=#27 then begin closegraph; halt; end;
until (length(t)=4)or(cha=#13)or(cha=#115)or(cha=#116)or(cha=#75)or(cha=#77)or(cha=#72)or(cha=#80);
end;
 
 
 
begin
initialization;
era:=1;
data(god,mesats,den);
godnow:=god;
mesatsnow:=mesats;
 
cleardevice;setbkcolor(8); setfillstyle(9,1); bar(0,0,639,479);
 
repeat
z:=1;
denned:=7;
nediela:=1;
wcalendar;
wmesats;
 
setcolor(15);
setfillstyle(1,9);
fillpoly(3,trv);
fillpoly(3,trn);
 
for dg:=-9999 to god-1 do
for dm:=1 to 12 do
for dd:=1 to dnei(dg,dm) do
begin denned:=denned+1;if denned=8 then denned:=1;
z:=z+1;if z=5 then z:=1; end;
 
for dm:=1 to 12 do begin casem(dm);
setfillstyle(1,8);
bar(allx+150*(x-1),ally+25+allintx*(y-1),allx+22+150*(x-1)+(8-1)*15,ally+20+allintx*(y-1)+6*allinty);
setfillstyle(9,1);
bar(allx+150*(x-1),ally+25+allintx*(y-1),allx+22+150*(x-1)+(8-1)*15,ally+20+allintx*(y-1)+6*allinty); end;
 
wgod(god);
 
for dm:=1 to 12 do begin casem(dm); dy:=0;
if (denned<>7)then begin nediela:=nediela-1; wnedela; end;
if (dm=1)and(denned=7) then begin nediela:=nediela-2; wnedela; end;
for dd:=1 to dnei(god,dm) do
begin denned:=denned+1;if denned=8 then begin denned:=1;dy:=dy+1; wnedela; end;
z:=z+1;if z=5 then z:=1;
wden;  end;
end;
 
pisat(god,cha);
 
until (cha=#27); closegraph;
end.
0
Модератор
62900 / 46930 / 32344
Регистрация: 18.05.2008
Сообщений: 113,713
13.08.2009, 07:47 16
Идея хорошая и оформление нормально только не все месяцы подписаны, сливаются названия дней и числа. Короче есть что доделывать.

Добавлено через 10 минут 20 секунд
нужно заменить на вот это
Так вообще бардак. Как-то неправильно написана работа с указателями, вникать лень. Но не вижу ни выделения ни освобождения памяти и выдает всякий мусор.
1
Босс
161 / 126 / 10
Регистрация: 03.06.2009
Сообщений: 750
13.08.2009, 12:59 17
Цитата Сообщение от Puporev Посмотреть сообщение
Идея хорошая и оформление нормально только не все месяцы подписаны, сливаются названия дней и числа. Короче есть что доделывать.
Это мне? Если да, то у меня все нормально. Не знаю, что у тебя там не так. может какие-то настройки о которых я не знаю? Даже не догадываюсь, 640*480, ничего не сливается, везде где пробовал - все нормально.
0
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
13.08.2009, 16:13  [ТС] 18
вот это не работает, идут символы непрерывно
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
 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 = ('sun', 'mon', 'tue', 'wed', 'thu', 'fri', 'sat');
const monthnames:array[1..12] of string= ('january', 'february', 'march', 'april', 'may', 'june',
 'july', 'august', 'september',  'october', 'november', 'december');
const celllength=4;
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<>d) or not light
                          then
                            if (c-7=d) and light
                               then Res[p+1]:=Res[p+1]+Formated(IntToStr(c),celllength-1)
                               else 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<>d) or not light
                          then
                            if (c-7=d) and light
                               then Res[p+1]:=Res[p+1]+Formated(IntToStr(c), celllength-1)
                               else 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:integer;
var year: integer;
var day, mon : byte;
begin
clrscr;
write('>Enter a number of year: '); readln(year);
for mon:=1 to 12 do
    begin
    if keypressed then ReadKey;
    for day:=1 to 31 do
       begin
          P:=ShowMonth(day, mon,year, true);
          clrscr;
          writeln('> ',monthnames[mon], ' ', year);
          writeln;
          a:=1;
          repeat
            if P^[a] <> '' then
            writeln('> '+P^[a]);
            Inc (a);
          until P^[a][1] = #0;
          if not keypressed then Delay (4000);
       end
    end
end.
0
Посланник моего господина
111 / 106 / 52
Регистрация: 02.05.2009
Сообщений: 181
13.08.2009, 17:07 19
Цитата Сообщение от Puporev Посмотреть сообщение
for cyberforum
Я так понял эта строка для прикола?
«Программа от Messager специально для cyberforum.ru». А что за прикол ты увидел?
Цитата Сообщение от Puporev Посмотреть сообщение
65535 это для какого-то кривого модуля *.TPL. До утра ждать надо. При нормальном модуле достаточно delay(400); или 0,4 сек.
http://ru.wikipedia.org/wiki/T... 0.BA.D0.B8
Как правило, время задержки процедуры Delay() зависит от частоты процессора, автор волен сам решить, какую задержку ему использовать.

Центральной частью кода является функция, возвращающая указатель на таблицу. Как применить результат, должен решить автор темы должен решить сам. Как вариант, был предложен способ поочередного использования для всех дат некоторого года; способ не самый показательный и эффективный.
Цитата Сообщение от Puporev Посмотреть сообщение
Еще вроде память не освобождается и при повторном запуске программы выкидывает вместе с нужной информацией всякую хрень.
Совершенно верно: память не освобождается, что в принципе, поправимо.
Кроме того, может смутить ещё один момент: в качестве собственно таблицы (переменная типа TTable) используется локальная переменная, которая размещена, по видимому, в стеке. Функция возвращает указатель на эту переменную. Стоит предположить, что при вызове каких-либо методов после ShowMonth() или каком-либо другом воздействии на стек может произойти самовольное изменение таблицы (строки 100-102: код P^[a]).
В связи с этим можно вместо локальной переменной Res:TTable использовать, скажем, Res:PTable, в начале процедуры инициализировать таблицу New(Res) и в ходе программы обращаться к таблице через Res^.
Цитата Сообщение от polivets
Индекс а выходил за границы массива, было выбрано неверное условие выхода из цикла.
Индекс проходит значения от 1 и увеличивается при каждом прохождении цила на 1. Следовательно, выйти за пределы может только сверху. Предполагалось, что из заявленных 16 строчек таблицы (строка 10 кода) хотя бы одна будет пустая (в конкретной задаче используются только 7 строчек — по числу дней недели — остальные пустые*) и именно на этой строчке происходит выход.
*Явно нигде не указывается, что все, кроме тех 7, которые заполнялись, будут пустые, TP7 как бы самостоятельно это дает. Тем не менее, лучше в начале метода явно указать, что все строки пусты (до заполнения)
Цитата Сообщение от polivets
Pascal
1
until P^[a][1] = #0;
В TP7 длина строки задается нулевым символом, все незадействованные не обязаны быть нулевыми. То же касается типа ShortString в Delphi.
Однако в AnsiString используется система определения длины по позиции первого #0 в строке (как, в прочем, и в C)
Иными словами такой подход определения выхода из цикла справедлив для Delphi AnsiString.
Цитата Сообщение от Ренат
вот это не работает, идут символы непрерывно
Можешь более подробно описать, что происходит у тебя на экране и что бы ты хотел там увидеть?
1
1 / 1 / 0
Регистрация: 12.08.2009
Сообщений: 10
13.08.2009, 17:14  [ТС] 20
программа запрашивает год. ввожу. идут символы, успеваю заметить календарь на февраль, потом опять символы, латинские и непонятные. бесконечно идут. мне дано задание: Вывести на дисплей календарь на текущий год. (после сессии дали задачи к следующей, только начали изучать. вот и думаю, как это сделать, если толком ничего не объяснили, даже до массивов не дошли. я раньше бейсик учил, 10 лет уже прошло.) ну, не вручную же забивать каждый месяц!? смешно. и задание вроде простое и в голову ничего не приходит. помогите!!!
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
13.08.2009, 17:14

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

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

Вывести календарь на текущий месяц
Нужна программа,которая выводит календарь на текущий месяц,так же нужны суммы по строкам и...

Вывести календарь на текущий месяц в виде таблицы
Помогите решить задачу. Создайте скрипт,который выводил бы календарь на текущий месяц в виде...

Вывести календарь на год
Когда берем по два элемента остается один, когда берем по 3,4,5 и 6 элементов тоже остается один, а...


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

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

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