home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPMAY90.ZIP / CALUNIT2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-16  |  2.1 KB  |  86 lines
  1. UNIT CalUnit2;
  2.  
  3. INTERFACE
  4. USES CRT,DOS,CalUnit;
  5. TYPE
  6.   DateSelect = OBJECT( Calendar )
  7.     ThisDay : Word;
  8.     CONSTRUCTOR Init( Month, Year, Day: Integer );
  9.     PROCEDURE   DrawCalendar;
  10.     PROCEDURE   SetDay( Day: Integer );
  11.     FUNCTION    GetDay: Integer;
  12.   END;
  13.  
  14. IMPLEMENTATION
  15. CONSTRUCTOR DateSelect.Init
  16.                     ( Month, Year, Day: Integer );
  17. BEGIN
  18.    SetYear( Year );
  19.    SetMonth( Month );
  20.    SetDay( Day );
  21.    DrawCalendar
  22. END;
  23.  
  24. PROCEDURE DateSelect.DrawCalendar;
  25. VAR
  26.   CurYear,CurMonth,CurDay,CurDow,
  27.   ThisDOW, DummyDate : Word;
  28.   I,DayPos,NbrDays   : Byte;
  29. CONST
  30.   DOM: ARRAY[1..12] OF Byte =
  31.        (31,28,31,30,31,30,31,31,30,31,30,31);
  32.   MonthName: ARRAY[1..12] OF String[3] =
  33.        ('Jan','Feb','Mar','Apr','May','Jun',
  34.         'Jul','Aug','Sep','Oct','Nov','Dec');
  35. BEGIN
  36.   GetDate(CurYear,CurMonth,CurDay,CurDow);
  37.   DummyDate := 1;
  38.   SetDate(ThisYear,ThisMonth,DummyDate);
  39.   {ThisDOW stands for This day of the week}
  40.   GetDate(ThisYear,ThisMonth,DummyDate,ThisDOW);
  41.   SetDate(CurYear,CurMonth,CurDay);
  42.   WriteLn('           ',MonthName[ThisMonth],
  43.           ' ',ThisYear);
  44.   WriteLn;
  45.   WriteLn('   S   M   T   W   R   F   S');
  46.   NbrDays := DOM[ThisMonth];
  47.   {Check for leap year, which occurs when the
  48.    year is evenly divisible by 4 and not evenly
  49.    divisable by 100 or if the year is evenly
  50.    divisable by 400}
  51.   IF ((ThisMonth = 2) AND
  52.      ((ThisYear MOD 4 = 0) AND
  53.      (ThisYear MOD 100 <> 0))
  54.      OR (ThisYear MOD 400 = 0))
  55.    THEN NbrDays := 29;
  56.   FOR I:= 1 TO NbrDays DO
  57.     BEGIN
  58.       DayPos := ThisDOW * 4 + 2;  {Position day #}
  59.       GotoXY(DayPos,WhereY);
  60.       Inc(ThisDOW);
  61.       IF I = ThisDay THEN HighVideo;
  62.       Write(I:3); NormVideo;
  63.       IF ThisDOW > 6 THEN
  64.             BEGIN
  65.                 ThisDOW := 0;
  66.                 WriteLn
  67.             END
  68.      END;
  69.     WriteLn;
  70.     WriteLn;
  71.     WriteLn( 'The current date is ', ThisMonth,
  72.              '/', ThisDay, '/', ThisYear )
  73. END;
  74.  
  75. PROCEDURE DateSelect.SetDay( Day: Integer );
  76. BEGIN
  77.   ThisDay := Day
  78. END;
  79.  
  80. FUNCTION DateSelect.GetDay: Integer;
  81. BEGIN
  82.   GetDay := ThisDay
  83. END;
  84.  
  85. END.
  86.