Написать программу, позволяющую получить календарь любого года, месяца

@mikl25 · Регистрация: 29.03.2013

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

Помогите написать программу:

Написать программу, позволяющую получить календарь любого года, месяца в предположительных пределах 1900-2050 гг. с указанием дня недели, соответствующего данному числу данного месяца.

@Catstail · 03.04.2013, 01:16

Вот что получилось:

Кликните здесь для просмотра всего текста

Lisp
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
209
210
//
//  Программа отображения диалога _Dlg_
//
 
(prog nil
 
      (try (dlgDestroy '_Dlg_) except Nil)
 
 
      (dlgCreate '_Dlg_ 398 460 "Календарик" &H8000000F)
 
      (dlgAddControl '_Dlg_ '_CMB_1 _COMBO 21 15 93 24 '("Courier New" 16 1 0 0) &H80000012 &H80000009)
 
      (dlgAddControl '_Dlg_ '_CMB_2 _COMBO 137 18 219 24 '("Courier New" 16 1 0 0) &H80000012 &H80000009)
 
      (dlgAddControl '_Dlg_ '_LBL_1 _LABEL 24 70 34 25 '("Tahoma" 15 1 0 0) "Пн" 0 &H80000012 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_2 _LABEL 24 112 34 24 '("Tahoma" 15 1 0 0) "Вт" 0 &H80000012 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_3 _LABEL 24 154 34 28 '("Tahoma" 15 1 0 0) "Ср" 0 &H80000012 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_4 _LABEL 24 196 34 26 '("Tahoma" 15 1 0 0) "Чт" 0 &H80000012 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_5 _LABEL 24 238 34 29 '("Tahoma" 15 1 0 0) "Пт" 0 &H80000012 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_7 _LABEL 24 280 34 31 '("Tahoma" 15 1 0 0) "Сб" 0 &HFF0000 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_8 _LABEL 24 322 34 27 '("Tahoma" 15 1 0 0) "Вс" 0 &HFF0000 &H8000000F)
 
      (dlgAddControl '_Dlg_ '_LBL_9 _LABEL 70 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_10 _LABEL 70 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_11 _LABEL 70 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_12 _LABEL 70 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_13 _LABEL 70 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_14 _LABEL 70 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_15 _LABEL 70 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_16 _LABEL 120 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_17 _LABEL 120 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_18 _LABEL 120 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_19 _LABEL 120 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_20 _LABEL 120 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_21 _LABEL 120 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_22 _LABEL 120 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_BUT_2 _BUTTON 18 356 352 55 '("Tahoma" 15 1 0 0) "Закрыть")
 
      (dlgAddControl '_Dlg_ '_LBL_23 _LABEL 170 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_24 _LABEL 170 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_25 _LABEL 170 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_26 _LABEL 170 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_27 _LABEL 170 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_28 _LABEL 170 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_29 _LABEL 170 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_30 _LABEL 220 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_31 _LABEL 220 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_32 _LABEL 220 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_33 _LABEL 220 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_34 _LABEL 220 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_35 _LABEL 220 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_38 _LABEL 220 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_39 _LABEL 270 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_40 _LABEL 270 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_41 _LABEL 270 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_42 _LABEL 270 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_43 _LABEL 270 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_44 _LABEL 270 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_45 _LABEL 270 322 34 23 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_46 _LABEL 320 70 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_47 _LABEL 320 112 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_48 _LABEL 320 154 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_49 _LABEL 320 196 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_50 _LABEL 320 238 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_51 _LABEL 320 280 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      (dlgAddControl '_Dlg_ '_LBL_52 _LABEL 320 322 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &HFF0000 &HFFFFFF)
 
      //
      // Пролог загрузки диалога _DLG_
      //
 
      (Prog () 
       (let ((mlist '("Январь" "Февраль" "Март" "Апрель" "Май" "Июнь" "Июль" "Август" "Сентябрь" "Октябрь" "Ноябрь" "Декабрь"))
             (clist '(_LBL_9  _LBL_10 _LBL_11 _LBL_12 _LBL_13 _LBL_14 _LBL_15 _LBL_16 _LBL_17 _LBL_18 _LBL_19 
                      _LBL_20 _LBL_21 _LBL_22 _LBL_23 _LBL_24 _LBL_25 _LBL_26 _LBL_27 _LBL_28 _LBL_29 _LBL_30 
                      _LBL_31 _LBL_32 _LBL_33 _LBL_34 _LBL_35 _LBL_38 _LBL_39 _LBL_40 _LBL_41 _LBL_42 _LBL_43 
                      _LBL_44 _LBL_45 _LBL_46 _LBL_47 _LBL_48 _LBL_49 _LBL_50 _LBL_51 _LBL_52))
             (mon '(31 28 31 30 31 30 31 31 30 31 30 31)) 
            )
          (dlgPutList '_CMB_1 (iter (for i from 1900 to 2100) (collecting (fix2str i))))     
          (dlgPutList '_CMB_2 mlist)           
          (defun ffix (x) (LET ((xx (FIX x))) (IF (> 0 (- x xx)) (- xx 1) xx)))
          (defun n-day (y m)
                (let* ((a1 (\ y 100))
                       (a2 (% y 100))
                       (sigv 0)
                       (sigv (if (and (zerop a2) (zerop (% a1 4))) 1 sigv))
                       (sigv (if (and (<> a2 0) (zerop (% a2 4))) 1 sigv))
                       (n (if (and (= 1 sigv) (<= m 2)) 1 0))          
                       (n (if (and (zerop sigv) (<= m 2)) 2 n))
                       (c (+ (ffix (* a2 365.25)) (ffix (* m 30.56)) 1 n))
                       (c (if (>= y 2000) (1- c) c))
                       (nn (% c 7))
                       (res (cond ((= nn 5) 1)
                                  ((= nn 6) 2)
                                  ((= nn 0) 3)
                                  ((= nn 1) 4)
                                  ((= nn 2) 5)
                                  ((= nn 3) 6)
                                  ((= nn 4) 7))))
                      (dotimes (i (length clist) t) (dlgPutText (getEl clist (1+ i)) " "))
                      (dotimes (d (getel mon m) t)
                          (dlgPutText (getEl clist res) (fix2str (+ 1 d)))
                          (setq res (+ 1 res)))))
           (defun get-req nil
             (let ((y (str2fix (car (dlgGetList '_CMB_1 1))))
                   (m (1+ (position (car (dlgGetList '_CMB_2 -1)) mlist))))
                  (n-day y m)))))
 
      //
      // Обработчик события CLICK для кнопки _BUT_2
      //
 
      (defun _BUT_2_Click  Nil 
 
        (dlgHide '_DLG_)
        (dlgDestroy '_DLG_)
 
      )
 
 
      //
      //   Назначение процедуры-события _BUT_2_Click  контролу _BUT_2
      //
 
      (dlgSetEvent '_BUT_2 '_BUT_2_Click )
 
      //
      // Обработчик события CLICK для вып. списка _CMB_1
      //
 
      (defun _CMB_1_Click  Nil 
        (get-req)
      )
 
      //
      //   Назначение процедуры-события _CMB_1_Click  контролу _CMB_1
      //
 
      (dlgSetEvent '_CMB_1 '_CMB_1_Click )
 
      //
      // Обработчик события CLICK для вып. списка _CMB_2
      //
 
      (defun _CMB_2_Click  Nil 
        (get-req)
      )
 
      //
      //   Назначение процедуры-события _CMB_2_Click  контролу _CMB_2
      //
 
      (dlgSetEvent '_CMB_2 '_CMB_2_Click )
 
 
      //
      //   Отображение диалога _Dlg_
      //
 
      (dlgShow '_Dlg_)
)

Кстати, формулы, которыми я пользовлся, взяты из старой книжечки Дрейфус, Ганглоф "Программирование на Фортране-4". А в нее формулы перекочевали из журнала IBM. Я много раз ими пользовался (с 1993-го года!) Ни разу не подвели!

@Catstail · 03.04.2013, 09:51

Хочу немного поправить код:

Кликните здесь для просмотра всего текста

Lisp
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
//
//  Программа отображения диалога _Dlg_
//
(prog nil
      (try (dlgDestroy '_Dlg_) except Nil)
      (dlgCreate '_Dlg_ 398 460 "Календарик" &H8000000F)
      (dlgAddControl '_Dlg_ '_CMB_1 _COMBO 21 15 93 24 '("Courier New" 16 1 0 0) &H80000012 &H80000009)
      (dlgAddControl '_Dlg_ '_CMB_2 _COMBO 137 15 219 24 '("Courier New" 16 1 0 0) &H80000012 &H80000009)
      (dlgAddControl '_Dlg_ '_LBL_1 _LABEL 24 70 34 25 '("Tahoma" 15 1 0 0) "Пн" 0 &H80000012 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_2 _LABEL 24 112 34 24 '("Tahoma" 15 1 0 0) "Вт" 0 &H80000012 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_3 _LABEL 24 154 34 28 '("Tahoma" 15 1 0 0) "Ср" 0 &H80000012 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_4 _LABEL 24 196 34 26 '("Tahoma" 15 1 0 0) "Чт" 0 &H80000012 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_5 _LABEL 24 238 34 29 '("Tahoma" 15 1 0 0) "Пт" 0 &H80000012 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_7 _LABEL 24 280 34 31 '("Tahoma" 15 1 0 0) "Сб" 0 &HFF0000 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_8 _LABEL 24 322 34 27 '("Tahoma" 15 1 0 0) "Вс" 0 &HFF0000 &H8000000F)
      (dlgAddControl '_Dlg_ '_LBL_9 _LABEL 70 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_10 _LABEL 70 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_11 _LABEL 70 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_12 _LABEL 70 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_13 _LABEL 70 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_14 _LABEL 70 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_15 _LABEL 70 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_16 _LABEL 120 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_17 _LABEL 120 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_18 _LABEL 120 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_19 _LABEL 120 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_20 _LABEL 120 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_21 _LABEL 120 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_22 _LABEL 120 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_BUT_2 _BUTTON 18 356 352 55 '("Tahoma" 15 1 0 0) "Закрыть")
      (dlgAddControl '_Dlg_ '_LBL_23 _LABEL 170 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_24 _LABEL 170 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_25 _LABEL 170 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_26 _LABEL 170 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_27 _LABEL 170 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_28 _LABEL 170 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_29 _LABEL 170 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_30 _LABEL 220 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_31 _LABEL 220 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_32 _LABEL 220 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_33 _LABEL 220 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_34 _LABEL 220 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_35 _LABEL 220 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_38 _LABEL 220 322 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_39 _LABEL 270 70 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_40 _LABEL 270 112 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_41 _LABEL 270 154 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_42 _LABEL 270 196 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_43 _LABEL 270 238 34 25 '("Tahoma" 15 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_44 _LABEL 270 280 34 25 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_45 _LABEL 270 322 34 23 '("Tahoma" 15 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_46 _LABEL 320 70 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_47 _LABEL 320 112 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_48 _LABEL 320 154 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_49 _LABEL 320 196 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_50 _LABEL 320 238 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &H80000012 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_51 _LABEL 320 280 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      (dlgAddControl '_Dlg_ '_LBL_52 _LABEL 320 322 34 25 '("Tahoma" 15,75 1 0 0) "" 2 &HFF0000 &HFFFFFF)
      //
      // Пролог загрузки диалога _DLG_
      //
      (Prog (yyyy mm) 
       (let ((mlist '("Январь" "Февраль" "Март" "Апрель" "Май" "Июнь" "Июль" "Август" "Сентябрь" "Октябрь" "Ноябрь" "Декабрь"))
             (clist '(_LBL_9  _LBL_10 _LBL_11 _LBL_12 _LBL_13 _LBL_14 _LBL_15 _LBL_16 _LBL_17 _LBL_18 _LBL_19 
                      _LBL_20 _LBL_21 _LBL_22 _LBL_23 _LBL_24 _LBL_25 _LBL_26 _LBL_27 _LBL_28 _LBL_29 _LBL_30 
                      _LBL_31 _LBL_32 _LBL_33 _LBL_34 _LBL_35 _LBL_38 _LBL_39 _LBL_40 _LBL_41 _LBL_42 _LBL_43 
                      _LBL_44 _LBL_45 _LBL_46 _LBL_47 _LBL_48 _LBL_49 _LBL_50 _LBL_51 _LBL_52))
             (mon '(31 28 31 30 31 30 31 31 30 31 30 31)) 
            )
          (dlgPutList '_CMB_1 (iter (for i from 1900 to 2100) (collecting (fix2str i))))     
          (dlgPutList '_CMB_2 mlist)           
          (let ((d (sysdate)))
               (dlgSelItem '_CMB_1 (- (str2fix (strMid d 7 4)) 1899))
               (dlgSelItem '_CMB_2 (str2fix (strMid d 1 2))))
          (defun ffix (x) (LET ((xx (FIX x))) (IF (> 0 (- x xx)) (- xx 1) xx)))
          (defun n-day (y m)
                (let* ((a1 (\ y 100))
                       (a2 (% y 100))
                       (sigv 0)
                       (sigv (if (and (zerop a2) (zerop (% a1 4))) 1 sigv))
                       (sigv (if (and (<> a2 0) (zerop (% a2 4))) 1 sigv))
                       (n (if (and (= 1 sigv) (<= m 2)) 1 0))          
                       (n (if (and (zerop sigv) (<= m 2)) 2 n))
                       (c (+ (ffix (* a2 365.25)) (ffix (* m 30.56)) 1 n))
                       (c (if (>= y 2000) (1- c) c))
                       (nn (% c 7))
                       (res (cond ((= nn 5) 1)
                                  ((= nn 6) 2)
                                  ((= nn 0) 3)
                                  ((= nn 1) 4)
                                  ((= nn 2) 5)
                                  ((= nn 3) 6)
                                  ((= nn 4) 7))))
                      (if (zerop sigv) (putel mon 2 28) (putel mon 2 29))           
                      (dotimes (i (length clist) t) (dlgPutText (getEl clist (1+ i)) " "))
                      (dotimes (d (getel mon m) t)
                          (dlgPutText (getEl clist res) (fix2str (+ 1 d)))
                          (setq res (+ 1 res)))))
           (defun get-req nil
             (let ((y (str2fix (car (dlgGetList '_CMB_1 1))))
                   (m (1+ (position (car (dlgGetList '_CMB_2 -1)) mlist))))
                  (n-day y m))))
           (get-req))
      //
      // Обработчик события CLICK для кнопки _BUT_2
      //
      (defun _BUT_2_Click  Nil 
        (dlgHide '_DLG_)
        (dlgDestroy '_DLG_)
      )
      //
      //   Назначение процедуры-события _BUT_2_Click  контролу _BUT_2
      //
      (dlgSetEvent '_BUT_2 '_BUT_2_Click )
      //
      // Обработчик события CLICK для вып. списка _CMB_1
      //
      (defun _CMB_1_Click  Nil 
        (get-req)
      )
      //
      //   Назначение процедуры-события _CMB_1_Click  контролу _CMB_1
      //
      (dlgSetEvent '_CMB_1 '_CMB_1_Click )
      //
      // Обработчик события CLICK для вып. списка _CMB_2
      //
      (defun _CMB_2_Click  Nil 
        (get-req)
      )
      //
      //   Назначение процедуры-события _CMB_2_Click  контролу _CMB_2
      //
      (dlgSetEvent '_CMB_2 '_CMB_2_Click )
      //
      //   Отображение диалога _Dlg_
      //
      (dlgShow '_Dlg_)
)

@helter · 03.04.2013, 12:25

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

Кстати, формулы, которыми я пользовлся, взяты из старой книжечки Дрейфус, Ганглоф "Программирование на Фортране-4". А в нее формулы перекочевали из журнала IBM. Я много раз ими пользовался (с 1993-го года!) Ни разу не подвели!

Да наверно, они безопасные, судя по присутствию рационального 365.25 и по тому, что странная постоянная 30.56 умножается только на небольшие числа. В алгоритме я не стал разбираться.

От mikl25 вряд ли чего-нибудь дождёшься, так что я и свои функции опубликую, не зря же их писал. Это те восемнадцать строчек, в которые укладывается домашнее задание.

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(defun leapp (y)
  (and (zerop (mod y 4))
       (multiple-value-bind (q r) (floor y 100)
         (not (and (zerop r)
                   (/= 0 (mod q 4)))))))
 
(defun month-offset (y m)
  (let ((month-offsets (make-array '(12) :initial-contents
                                   '(1 4 4 0 2 5 0 3 6 1 4 6))))
    (if (> m 2)
        (svref month-offsets (- m 1))
        (if (leapp y)
            (- (svref month-offsets (- m 1)) 1)
            (svref month-offsets (- m 1))))))
  
(defun day (y m d)
  (let ((leap-count (+ (- (floor y 4) (floor y 100)) (floor y 400))))
    (mod (+ 5 y leap-count (month-offset y m) d) 7)))

Основная функция - day. Главным образом, она вычисляет смещение дня недели в году, накопившееся за нашу эру и смещение в месяце. Это будет номер года плюс число високосных годов (с учётом самого года, если он високосный, потому что сдвиг на 2 дня начинается в самом високосном году). Поправка +5 служит для того, чтобы остаток 1 соответствовал именно понедельнику; на её выбор влияет и выбранный способ измерения смещения месяцев.

Число високосных лет определяется просто: вековой год является високосным если и только если число сотен делится на 4 (1600, 2000). Поэтому число високосных годов будет целая часть от деления года на 4 (каждый четвёртый), из этого вычел все вековые годы и добавил високосные вековые годы.

Далее, месяцы сдвинуты друг относительно друга по дням недели на фиксированную величину. Этот сдвиг даётся функцией month-offset. Единственное исключение - январь и февраль високосного года. В нашем алгоритме мы вносим в число високосных годов текущий год, то есть для дат текущего високосного года предполагается сдвиг на два дня по сравнению с прошлым годом. Однако этот сдвиг начинается только с марта. Поэтому для високосного года уменьшается на 1 месячный член января и февраля. Поэтому же month-offset зависит и от месяца, и от года (на самом деле можно было бы ограничиться зависимостью от високосности/невисокосности, но уж написал как написал).

Ну вроде и всё.

В книге Куликова, на которой я основываюсь, алгоритм был немного усложнён (с точки зрения именно алгоритмической), чтобы сделать эффективными вычисления в уме. Компьютер не испытывает проблем со счётом, так что может быть, что для него и мой алгоритм излишне сложен, и было бы удобнее пересчитывать дату в номер дня нашей эры (и миллиона дней ещё не прошло!). Хотя вычисления вроде те же, просто в разные моменты берём по mod 7. Если мы захотим сделать программу для арабского календаря, там как раз проще всего считать дни навалом.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@mikl25 0 / 0 / 0 Регистрация: 29.03.2013 Сообщений: 81

	Написать программу, позволяющую получить календарь любого года, месяца 01.04.2013, 17:40. Показов 4477. Ответов 22 Метки нет (Все метки) Помогите написать программу: Написать программу, позволяющую получить календарь любого года, месяца в предположительных пределах 1900-2050 гг. с указанием дня недели, соответствующего данному числу данного месяца. 0