Listing: 1 IMPLEMENTATION MODULE DateFunctions; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, WI 8 * All rights reserved 9 * (414) 468=6040 10 * 11 * $Header: D:/logfiles/mods/datefunc.mov 1.4 17 Mar 1991 17:53:06 coleb $ 12 * 13 *) 14 15 16 (*EntryDiag: 17 IMPORT Diagnostics; 18 :EntryDiag*) 19 20 IMPORT M2Strings; 21 IMPORT PosUtils; 22 IMPORT StrConv; 23 IMPORT StrEdit; 24 25 VAR 26 Initialized : BOOLEAN; 27 28 TYPE 29 RepType = (DB, US, UK, USMilitary, Correspondence); 30 31 32 VAR 33 monthtotal: ARRAY [1..12] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 34 monthtotalleap : ARRAY[1..12] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 35 monthsize: ARRAY [1..12] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 36 37 38 PROCEDURE InitMonthTotal; 39 BEGIN 40 monthtotal[1] := 0; monthtotalleap[1] := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 41 monthtotal[2] := 31; monthtotalleap[2] := 31; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 42 monthtotal[3] := 59; monthtotalleap[3] := 60; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 43 monthtotal[4] := 90; monthtotalleap[4] := 91; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 monthtotal[5] := 120; monthtotalleap[5] := 121; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 monthtotal[6] := 151; monthtotalleap[6] := 152; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 monthtotal[7] := 181; monthtotalleap[7] := 182; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 monthtotal[8] := 212; monthtotalleap[8] := 213; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 monthtotal[9] := 243; monthtotalleap[9] := 244; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 monthtotal[10] := 273; monthtotalleap[10] := 274; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 monthtotal[11] := 304; monthtotalleap[11] := 305; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 monthtotal[12] := 334; monthtotalleap[12] := 335; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 52 END InitMonthTotal; ***** ^ not supported yet 53 54 (* 55 PROCEDURE DateToStr2(d: Date; VAR s: ARRAY OF CHAR; 56 representation: RepType); 57 VAR daystr, mostr: ARRAY [0..1] OF CHAR; 58 yrstr: ARRAY [0..3] OF CHAR; 59 60 BEGIN 61 END DateToStr2; 62 *) 63 64 65 PROCEDURE DateToStr(d: Date; VAR s: ARRAY OF CHAR; VAR OK: BOOLEAN); ***** ^ undeclared identifier ***** ^ not supported yet 66 67 VAR i: CARDINAL; 68 69 PROCEDURE PutDigits(n: CARDINAL); 70 BEGIN 71 IF n < 10 THEN 72 s[i] := '0'; ***** ^ not supported yet ***** ^ not supported yet 73 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 74 s[i] := CHR(n + 48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 75 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 76 ELSE 77 n := n MOD 100; 78 s[i] := CHR((n DIV 10) + 48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 79 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 80 s[i] := CHR((n MOD 10) + 48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 81 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 82 END; 83 END PutDigits; ***** ^ not supported yet 84 85 BEGIN 86 IF (HIGH(s) < 7) OR (NOT ValidDate(d))THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 87 OK := FALSE; 88 FOR i := 0 TO HIGH(s) DO ***** ^ undeclared identifier ***** ^ not supported yet 89 s[i] := '*'; ***** ^ not supported yet ***** ^ not supported yet 90 END; 91 ELSE 92 OK := TRUE; 93 i := 0; 94 PutDigits(d.mo); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 s[i] := '-'; ***** ^ not supported yet ***** ^ not supported yet 96 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 97 PutDigits(d.day); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 98 s[i] := '-'; ***** ^ not supported yet ***** ^ not supported yet 99 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 100 PutDigits(d.yr-1900); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 101 IF HIGH(s) > 8 THEN ***** ^ undeclared identifier ***** ^ not supported yet 102 s[i] := 0C; ***** ^ not supported yet ***** ^ not supported yet 103 END; 104 END; 105 END DateToStr; ***** ^ not supported yet 106 107 108 PROCEDURE Digit(c : CHAR) : BOOLEAN; 109 BEGIN 110 RETURN (c>='0') AND (c<='9'); 111 END Digit; ***** ^ not supported yet 112 113 PROCEDURE StrToDate(s: ARRAY OF CHAR; VAR d: Date; VAR OK: BOOLEAN); ***** ^ not supported yet ***** ^ undeclared identifier 114 (* expects mm dd yy *) 115 VAR i, yeardigits: CARDINAL; 116 BEGIN 117 i := 0; 118 WHILE (i <= HIGH(s)) AND (NOT Digit(s[i])) DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 INC(i) ***** ^ undeclared identifier ***** ^ not supported yet 120 END; 121 d.mo := 0; d.yr := 0; d.day := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 122 WHILE (i <= HIGH(s)) AND (Digit(s[i])) DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 d.mo := d.mo * 10 + (ORD(s[i])-48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 124 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 125 END; 126 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 127 WHILE (i <= HIGH(s)) AND (Digit(s[i])) DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 d.day := d.day * 10 + (ORD(s[i])-48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 129 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 130 END; 131 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 132 yeardigits := 0; 133 WHILE (i <= HIGH(s)) AND (Digit(s[i])) DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 d.yr := d.yr * 10 + (ORD(s[i])-48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 135 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 136 INC(yeardigits); ***** ^ undeclared identifier ***** ^ not supported yet 137 END; 138 IF yeardigits <= 2 THEN 139 IF d.yr<40 ***** ^ not supported yet ***** ^ not supported yet 140 THEN 141 INC(d.yr,2000); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 142 ELSE 143 INC(d.yr, 1900); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 144 END; 145 END; 146 IF NOT ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 147 d.yr := 0; d.mo := 0; d.day := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 OK := FALSE 149 ELSE 150 OK := TRUE; 151 END; 152 END StrToDate; ***** ^ not supported yet 153 154 155 PROCEDURE StrToDate2( DateStr: ARRAY OF CHAR; EuropeanStyle: BOOLEAN; ***** ^ not supported yet 156 VAR day, month, year: CARDINAL ): BOOLEAN; 157 VAR 158 spot: CARDINAL; 159 separator: ARRAY [0..0] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 160 BEGIN 161 StrEdit.CrunchBlanks( DateStr ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 162 separator[0] := '/'; ***** ^ not supported yet ***** ^ not supported yet 163 IF NOT PosUtils.PresentPos( separator, DateStr, spot ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 164 separator[0] := '-'; ***** ^ not supported yet ***** ^ not supported yet 165 IF NOT PosUtils.PresentPos( separator, DateStr, spot ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 separator[0] := ':'; ***** ^ not supported yet ***** ^ not supported yet 167 IF NOT PosUtils.PresentPos( separator, DateStr, spot ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 168 separator[0] := ' '; ***** ^ not supported yet ***** ^ not supported yet 169 IF NOT PosUtils.PresentPos( separator, DateStr, spot ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 170 RETURN FALSE; 171 END; 172 END; 173 END; 174 END; 175 IF NOT StrConv.StrToCardinal( DateStr, 0, day ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 176 RETURN FALSE; 177 END; 178 IF NOT StrConv.StrToCardinal( DateStr, spot + 1, month ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 RETURN FALSE; 180 END; 181 IF (month > 12) OR (NOT EuropeanStyle) THEN 182 (* use year as a temp to do swap *) 183 year := day; 184 day := month; 185 month := year; 186 END; 187 spot := PosUtils.Positn( separator, DateStr, spot + 1 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 188 IF spot > HIGH(DateStr) THEN ***** ^ undeclared identifier ***** ^ not supported yet 189 RETURN FALSE; 190 END; 191 IF NOT StrConv.StrToCardinal( DateStr, spot + 1, year ) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 192 RETURN FALSE; 193 END; 194 RETURN TRUE; 195 END StrToDate2; ***** ^ not supported yet 196 197 198 PROCEDURE Day(d: Date): CARDINAL; ***** ^ undeclared identifier 199 BEGIN 200 IF ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 201 RETURN d.day ***** ^ not supported yet ***** ^ not supported yet 202 ELSE 203 RETURN 0 204 END; 205 END Day; ***** ^ not supported yet 206 207 208 PROCEDURE LeapYear(year: CARDINAL): BOOLEAN; 209 BEGIN 210 RETURN ((year MOD 4 = 0) AND (year MOD 100 # 0)) OR (year MOD 400 = 0) 211 END LeapYear; ***** ^ not supported yet 212 213 214 PROCEDURE DayOfWeek(d: Date; VAR wkday: ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 215 VAR 216 daytable: ARRAY [1..12] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 217 centurytable: ARRAY [1..5] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 218 century, yearincent, result, i: CARDINAL; 219 220 PROCEDURE InitCent; 221 BEGIN 222 centurytable[1] := 1; ***** ^ not supported yet ***** ^ not supported yet 223 centurytable[2] := 2; ***** ^ not supported yet ***** ^ not supported yet 224 centurytable[3] := 0; ***** ^ not supported yet ***** ^ not supported yet 225 centurytable[4] := 6; ***** ^ not supported yet ***** ^ not supported yet 226 centurytable[5] := 4; ***** ^ not supported yet ***** ^ not supported yet 227 END InitCent; ***** ^ not supported yet 228 229 PROCEDURE InitDayTable; 230 BEGIN 231 daytable[1] := 0; ***** ^ not supported yet ***** ^ not supported yet 232 daytable[2] := 3; ***** ^ not supported yet ***** ^ not supported yet 233 daytable[3] := 3; ***** ^ not supported yet ***** ^ not supported yet 234 daytable[4] := 6; ***** ^ not supported yet ***** ^ not supported yet 235 daytable[5] := 1; ***** ^ not supported yet ***** ^ not supported yet 236 daytable[6] := 4; ***** ^ not supported yet ***** ^ not supported yet 237 daytable[7] := 6; ***** ^ not supported yet ***** ^ not supported yet 238 daytable[8] := 2; ***** ^ not supported yet ***** ^ not supported yet 239 daytable[9] := 5; ***** ^ not supported yet ***** ^ not supported yet 240 daytable[10] := 0; ***** ^ not supported yet ***** ^ not supported yet 241 daytable[11] := 3; ***** ^ not supported yet ***** ^ not supported yet 242 daytable[12] := 5; ***** ^ not supported yet ***** ^ not supported yet 243 END InitDayTable; ***** ^ not supported yet 244 245 BEGIN 246 IF ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 247 InitDayTable; ***** ^ not supported yet 248 InitCent; ***** ^ not supported yet 249 IF LeapYear(d.yr) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 250 daytable[1] := 6; ***** ^ not supported yet ***** ^ not supported yet 251 daytable[2] := 2; ***** ^ not supported yet ***** ^ not supported yet 252 END; 253 century := d.yr DIV 100; ***** ^ not supported yet ***** ^ not supported yet 254 yearincent := d.yr - century*100; ***** ^ not supported yet ***** ^ not supported yet 255 result := centurytable[century-16] + yearincent + ***** ^ not supported yet ***** ^ not supported yet 256 (yearincent DIV 4) + daytable[d.mo] + d.day; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 (* NOTE!!! the above configuration is only likely to be accurate 258 for 20th & 21st century *) 259 CASE result MOD 7 OF 260 0: M2Strings.Copy("Sunday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 261 | 1: M2Strings.Copy("Monday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 262 | 2: M2Strings.Copy("Tuesday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 263 | 3: M2Strings.Copy("Wednesday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 264 | 4: M2Strings.Copy("Thursday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 265 | 5: M2Strings.Copy("Friday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 266 | 6: M2Strings.Copy("Saturday", 0, HIGH(wkday), wkday); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 267 END; (* case*) 268 ELSE 269 FOR i := 0 TO HIGH(wkday) DO ***** ^ undeclared identifier ***** ^ not supported yet 270 wkday[i] := '*' ***** ^ not supported yet ***** ^ not supported yet 271 END; 272 END; 273 END DayOfWeek; ***** ^ not supported yet 274 275 PROCEDURE Month(d: Date): CARDINAL; ***** ^ undeclared identifier 276 BEGIN 277 IF ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 278 RETURN d.mo ***** ^ not supported yet ***** ^ not supported yet 279 ELSE 280 RETURN 0 281 END; 282 END Month; ***** ^ not supported yet 283 284 PROCEDURE CalendarMonth(d: Date; VAR cmonth: ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 285 BEGIN 286 IF ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 287 CASE d.mo OF ***** ^ not supported yet ***** ^ not supported yet 288 1: M2Strings.Copy('January', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 289 | 2: M2Strings.Copy('February', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 290 | 3: M2Strings.Copy('March', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 291 | 4: M2Strings.Copy('April', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 292 | 5: M2Strings.Copy('May', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 293 | 6: M2Strings.Copy('June', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 294 | 7: M2Strings.Copy('July', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 295 | 8: M2Strings.Copy('August', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 296 | 9: M2Strings.Copy('September', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 297 | 10: M2Strings.Copy('October', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 298 | 11: M2Strings.Copy('November', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 299 | 12: M2Strings.Copy('December', 0, 9, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 300 END; (* case *) 301 ELSE 302 M2Strings.Copy('********',0, 8, cmonth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 303 END; 304 END CalendarMonth; ***** ^ not supported yet 305 306 307 PROCEDURE Year(d: Date): CARDINAL; ***** ^ undeclared identifier 308 BEGIN 309 IF ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 310 RETURN (d.yr) ***** ^ not supported yet ***** ^ not supported yet 311 ELSE 312 RETURN 0 313 END; 314 END Year; ***** ^ not supported yet 315 316 317 PROCEDURE DateToWritten(d: Date; VAR written: ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 318 VAR 319 temp: ARRAY [0..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 320 BEGIN 321 CalendarMonth(d, written); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 M2Strings.Concat(written, ' ', written); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 323 StrConv.CardinalToStr(d.day, 0, temp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 324 M2Strings.Concat(written, temp, written); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 325 M2Strings.Concat(written, ', ', written); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 326 StrConv.CardinalToStr(d.yr, 0, temp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 327 M2Strings.Concat(written, temp, written); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 328 END DateToWritten; ***** ^ not supported yet 329 330 331 PROCEDURE DatePlusDays(VAR d: Date; days: CARDINAL; VAR OK: BOOLEAN); ***** ^ undeclared identifier 332 BEGIN 333 IF NOT ValidDate(d) THEN ***** ^ undeclared identifier ***** ^ not supported yet 334 WITH d DO ***** ^ not supported yet 335 yr := 0; ***** ^ undeclared identifier 336 mo := 0; ***** ^ undeclared identifier 337 day := 0; ***** ^ undeclared identifier 338 END; ***** ^ not supported yet 339 OK := FALSE ***** ^ undeclared identifier 340 ELSE 341 CardToDate(DaysSince1900(d) + days, d); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 342 OK := TRUE ***** ^ undeclared identifier 343 END; 344 END DatePlusDays; ***** ^ not supported yet 345 346 347 PROCEDURE InitMonths; 348 BEGIN 349 monthsize[1] := 31; ***** ^ not supported yet ***** ^ not supported yet 350 monthsize[2] := 28; ***** ^ not supported yet ***** ^ not supported yet 351 monthsize[3] := 31; ***** ^ not supported yet ***** ^ not supported yet 352 monthsize[4] := 30; ***** ^ not supported yet ***** ^ not supported yet 353 monthsize[5] := 31; ***** ^ not supported yet ***** ^ not supported yet 354 monthsize[6] := 30; ***** ^ not supported yet ***** ^ not supported yet 355 monthsize[7] := 31; ***** ^ not supported yet ***** ^ not supported yet 356 monthsize[8] := 31; ***** ^ not supported yet ***** ^ not supported yet 357 monthsize[9] := 30; ***** ^ not supported yet ***** ^ not supported yet 358 monthsize[10] := 31; ***** ^ not supported yet ***** ^ not supported yet 359 monthsize[11] := 30; ***** ^ not supported yet ***** ^ not supported yet 360 monthsize[12] := 31; ***** ^ not supported yet ***** ^ not supported yet 361 END InitMonths; ***** ^ not supported yet 362 363 364 PROCEDURE ValidDate(d: Date): BOOLEAN; ***** ^ undeclared identifier 365 366 BEGIN 367 IF LeapYear(d.yr)THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 368 monthsize[2] := 29; ***** ^ not supported yet ***** ^ not supported yet 369 ELSE 370 monthsize[2] := 28; ***** ^ not supported yet ***** ^ not supported yet 371 END; 372 RETURN((d.mo >= 1) AND (d.mo <= 12)) AND ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 373 ((d.day >=1) AND (d.day <= monthsize[d.mo])) AND ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 374 ((d.yr >= MinYear) AND (d.yr <= MaxYear)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 375 END ValidDate; ***** ^ not supported yet 376 377 378 PROCEDURE DaysSince1900(d: Date): CARDINAL; ***** ^ undeclared identifier 379 VAR 380 yearsSince, leapYearsSince, result: CARDINAL; 381 BEGIN 382 IF ValidDate(d) THEN ***** ^ not supported yet ***** ^ not supported yet 383 yearsSince := (d.yr - 1900) * 365; ***** ^ not supported yet ***** ^ not supported yet 384 result:=d.yr-1900; ***** ^ not supported yet ***** ^ not supported yet 385 IF result>1 THEN DEC(result) END; ***** ^ undeclared identifier ***** ^ not supported yet 386 leapYearsSince := (result) DIV 4; 387 result := yearsSince + leapYearsSince + DayOfYear(d)-1; ***** ^ undeclared identifier ***** ^ not supported yet 388 (* IF LeapYear(d.yr) AND (d.mo > 2) THEN 389 INC( result ); 390 END; *) 391 RETURN result 392 ELSE 393 RETURN 0 394 END; 395 END DaysSince1900; ***** ^ not supported yet 396 397 398 PROCEDURE DayOfYear(d:Date): CARDINAL; ***** ^ undeclared identifier 399 (* Returns 0 if the date is not Valid *) 400 VAR julian: CARDINAL; 401 402 BEGIN 403 IF ValidDate(d) THEN ***** ^ not supported yet ***** ^ not supported yet 404 IF LeapYear(d.yr) AND (d.mo > 2) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 405 julian := monthtotalleap[d.mo] + d.day; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 406 ELSE 407 julian := monthtotal[d.mo] + d.day; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 408 END; 409 RETURN julian 410 ELSE 411 RETURN 0 412 END; 413 END DayOfYear; ***** ^ not supported yet 414 415 PROCEDURE CardToDate(n: CARDINAL; VAR d: Date); ***** ^ undeclared identifier 416 VAR julday, 417 c,LeapYears: CARDINAL; 418 BEGIN 419 d.yr := n DIV 365; ***** ^ not supported yet ***** ^ not supported yet 420 julday:= n MOD 365+1; 421 c:=d.yr; ***** ^ not supported yet ***** ^ not supported yet 422 IF c >1 THEN DEC(c) END; ***** ^ undeclared identifier ***** ^ not supported yet 423 LeapYears:= c DIV 4;(* leap years is to count preceding not current *) 424 IF (julday > LeapYears) THEN 425 DEC(julday,LeapYears) ***** ^ undeclared identifier ***** ^ not supported yet 426 ELSE 427 julday:=julday+365-LeapYears; 428 DEC(d.yr); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 429 IF( d.yr#0) AND ((d.yr MOD 4) =0) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 430 THEN 431 INC(julday);(* do not want to count leap day twice *) ***** ^ undeclared identifier ***** ^ not supported yet 432 END; 433 END; 434 d.yr := d.yr + 1900; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 435 d.mo := 0; ***** ^ not supported yet ***** ^ not supported yet 436 d.day := 0; ***** ^ not supported yet ***** ^ not supported yet 437 IF NOT LeapYear(d.yr) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 438 (* DEC (julday);*) 439 REPEAT 440 INC(d.mo) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 441 UNTIL (d.mo = 12) OR (julday <= monthtotal[d.mo + 1]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 442 d.day := julday - monthtotal[d.mo]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 443 ELSE 444 REPEAT 445 INC(d.mo) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 446 UNTIL (d.mo = 12) OR (julday <= monthtotalleap[d.mo + 1]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 447 (* note: can't just add 1 -- it throws January off!! *) 448 d.day := julday - (monthtotalleap[d.mo]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 449 END; 450 END CardToDate; ***** ^ not supported yet 451 452 453 PROCEDURE CompareDates(d1, d2: Date): Comparison; ***** ^ undeclared identifier ***** ^ undeclared identifier 454 BEGIN 455 IF d1.yr > d2.yr THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 456 RETURN DateGreater ***** ^ undeclared identifier 457 ELSIF d1.yr < d2.yr THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 458 RETURN DateLess ***** ^ undeclared identifier 459 ELSE 460 IF d1.mo > d2.mo THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 461 RETURN DateGreater ***** ^ undeclared identifier 462 ELSIF d1.mo < d2.mo THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 463 RETURN DateLess ***** ^ undeclared identifier 464 ELSE 465 IF d1.day > d2.day THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 466 RETURN DateGreater ***** ^ undeclared identifier 467 ELSIF d1.day < d2.day THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 468 RETURN DateLess ***** ^ undeclared identifier 469 ELSE 470 RETURN DateEqual ***** ^ undeclared identifier 471 END; 472 END; 473 END; 474 RETURN DateEqual; ***** ^ undeclared identifier 475 END CompareDates; ***** ^ not supported yet 476 477 478 PROCEDURE DateDiff(d1, d2: Date): CARDINAL; ***** ^ undeclared identifier 479 BEGIN 480 IF CompareDates(d1, d2) = DateGreater THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 481 RETURN(DaysSince1900(d1) - DaysSince1900(d2)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 482 ELSE 483 RETURN(DaysSince1900(d2) - DaysSince1900(d1)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 484 END; 485 END DateDiff; ***** ^ not supported yet 486 487 488 PROCEDURE Init(); 489 BEGIN 490 IF Initialized THEN 491 RETURN; 492 ELSE 493 Initialized := TRUE; 494 END; 495 (*EntryDiag: 496 Diagnostics.Init(); 497 :EntryDiag*) 498 M2Strings.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 499 PosUtils.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 500 StrConv.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 501 StrEdit.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 502 (*EntryDiag: 503 Diagnostics.diagS( 'Entering DateFunctions', '' ); 504 :EntryDiag*) 505 506 InitMonthTotal(); ***** ^ not supported yet ***** ^ not supported yet 507 InitMonths(); ***** ^ not supported yet ***** ^ not supported yet 508 509 (*EntryDiag: 510 Diagnostics.diagS( 'Exiting DateFunctions', '' ); 511 :EntryDiag*) 512 END Init; ***** ^ not supported yet 513 514 515 BEGIN 516 Initialized := FALSE; 517 Init(); ***** ^ not supported yet ***** ^ not supported yet 518 END DateFunctions. ***** ^ not supported yet 699 errors