home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / insidetp / 1990_05 / calunit.pas < prev    next >
Pascal/Delphi Source File  |  1990-04-16  |  2KB  |  110 lines
  1. UNIT CalUnit;
  2.  
  3. INTERFACE
  4. USES CRT,DOS;
  5. TYPE
  6.   Calendar = OBJECT
  7.     ThisMonth, ThisYear : Word;
  8.     CONSTRUCTOR Init(Month, Year: Integer);
  9.     PROCEDURE    DrawCalendar;
  10.     PROCEDURE    SetMonth(Month: Integer);
  11.     PROCEDURE    SetYear(Year: Integer);
  12.     FUNCTION    GetMonth: Integer;
  13.     FUNCTION    GetYear: Integer;
  14.     DESTRUCTOR    Done;
  15.   END;
  16.  
  17. IMPLEMENTATION
  18. CONSTRUCTOR Calendar.Init(Month, Year: Integer);
  19. BEGIN
  20.    SetYear(Year);
  21.    SetMonth(Month);
  22.    DrawCalendar;
  23. END;
  24.  
  25. PROCEDURE Calendar.DrawCalendar;
  26. VAR
  27.   CurYear,CurMonth,CurDay,CurDow,
  28.   ThisDay,ThisDOW         : Word;
  29.   I,DayPos,NbrDays   : Byte;
  30. CONST
  31.   DOM: ARRAY[1..12] OF Byte =
  32.        (31,28,31,30,31,30,31,31,30,31,30,31);
  33.   MonthName: ARRAY[1..12] OF String[3] =
  34.        ('Jan','Feb','Mar','Apr','May','Jun',
  35.         'Jul','Aug','Sep','Oct','Nov','Dec');
  36. BEGIN
  37.   GetDate(CurYear,CurMonth,CurDay,CurDow);
  38.   ThisDay := 1;
  39.   SetDate(ThisYear,ThisMonth,ThisDay);
  40.   GetDate(ThisYear,ThisMonth,ThisDay,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.       Write(I:3);
  62.       IF ThisDOW > 6 THEN
  63.             BEGIN
  64.                 ThisDOW := 0;
  65.                 WriteLn
  66.             END
  67.     END;
  68.     WriteLn
  69. END;
  70.  
  71. PROCEDURE Calendar.SetMonth(Month: Integer);
  72. BEGIN
  73.    ThisMonth := Month;
  74.    WHILE ThisMonth < 1 DO
  75.    BEGIN
  76.       Dec(ThisYear);
  77.       Inc(ThisMonth, 12)
  78.    END;
  79.    WHILE ThisMonth > 12 DO
  80.    BEGIN
  81.       Inc(ThisYear);
  82.       Dec(ThisMonth, 12)
  83.    END
  84. END;
  85.  
  86. PROCEDURE Calendar.SetYear(Year: Integer);
  87. BEGIN
  88.    ThisYear := Year;
  89. END;
  90.  
  91. FUNCTION Calendar.GetMonth: Integer;
  92. BEGIN
  93.    GetMonth := ThisMonth
  94. END;
  95.  
  96. FUNCTION Calendar.GetYear: Integer;
  97. BEGIN
  98.    GetYear := ThisYear
  99. END;
  100.  
  101. DESTRUCTOR Calendar.Done;
  102. BEGIN
  103.    {for dynamic object instances,
  104.      the Done method still works even
  105.      though it contains nothing except
  106.      the destructor declaration          }
  107. END;
  108.  
  109. END.
  110.