home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / insidetp / 1990_04 / calunit.pas < prev    next >
Pascal/Delphi Source File  |  1990-03-19  |  3KB  |  129 lines
  1. UNIT CalUnit;
  2.  
  3. INTERFACE
  4.  
  5. USES CRT,DOS;
  6.  
  7. TYPE
  8.   Calendar = OBJECT
  9.     ThisMonth, ThisYear : Word;
  10.     CONSTRUCTOR Init(Month, Year: Integer);
  11.     PROCEDURE    DrawCalendar;
  12.     PROCEDURE    SetMonth(Month: Integer);
  13.     PROCEDURE    SetYear(Year: Integer);
  14.     FUNCTION    GetMonth: Integer;
  15.     FUNCTION    GetYear: Integer;
  16.     DESTRUCTOR    Done;
  17.   END;
  18.  
  19. IMPLEMENTATION
  20.  
  21. CONSTRUCTOR Calendar.Init(Month, Year: Integer);
  22. BEGIN
  23.    SetYear(Year);
  24.    SetMonth(Month);
  25.    DrawCalendar;
  26. END;
  27.  
  28. PROCEDURE Calendar.DrawCalendar;
  29.  
  30. VAR
  31.   CurYear,CurMonth,CurDay,CurDow,
  32.   ThisDay,ThisDOW    : Word;
  33.   I,DayPos,NbrDays   : Byte;
  34.  
  35. CONST
  36.   DOM: ARRAY[1..12] OF Byte =
  37.        (31,28,31,30,31,30,31,31,30,31,30,31);
  38.   MonthName: ARRAY[1..12] OF String[3] =
  39.        ('Jan','Feb','Mar','Apr','May','Jun',
  40.     'Jul','Aug','Sep','Oct','Nov','Dec');
  41.  
  42. BEGIN
  43.  
  44.   GetDate(CurYear,CurMonth,CurDay,CurDow);
  45.  
  46.   {Set to day 1 so we can use GetDate function}
  47.   ThisDay := 1;
  48.  
  49.   SetDate(ThisYear,ThisMonth,ThisDay);
  50.  
  51.   {ThisDOW stands for This day of the week}
  52.  
  53.   GetDate(ThisYear,ThisMonth,ThisDay,ThisDOW);
  54.  
  55.   SetDate(CurYear,CurMonth,CurDay);
  56.  
  57.   WriteLn('           ',MonthName[ThisMonth],
  58.       ' ',ThisYear);
  59.   WriteLn;
  60.   WriteLn('   S   M   T   W   R   F   S');
  61.  
  62.   NbrDays := DOM[ThisMonth];
  63.  
  64.   {Check for leap year, which occurs when the
  65.    year is evenly divisible by 4 and not evenly
  66.    divisable by 100 or if the year is evenly
  67.    divisable by 400}
  68.  
  69.   IF ((ThisMonth = 2) AND
  70.      ((ThisYear MOD 4 = 0) AND
  71.       (ThisYear MOD 100 <> 0))
  72.      OR (ThisYear MOD 400 = 0))
  73.    THEN NbrDays := 29;
  74.  
  75.   FOR I:= 1 TO NbrDays DO
  76.     BEGIN
  77.       DayPos := ThisDOW * 4 + 2;  {Position day #}
  78.       GotoXY(DayPos,WhereY);
  79.       Inc(ThisDOW);
  80.       Write(I:3);
  81.       IF ThisDOW > 6 THEN
  82.     BEGIN
  83.       ThisDOW := 0;
  84.       WriteLn
  85.     END
  86.     END;
  87.     WriteLn
  88. END;
  89.  
  90. PROCEDURE Calendar.SetMonth(Month: Integer);
  91. BEGIN
  92.    ThisMonth := Month;
  93.    WHILE ThisMonth < 1 DO
  94.    BEGIN
  95.       Dec(ThisYear);
  96.       Inc(ThisMonth, 12);
  97.    END;
  98.    WHILE ThisMonth > 12 DO
  99.    BEGIN
  100.       Inc(ThisYear);
  101.       Dec(ThisMonth, 12);
  102.    END;
  103. END;
  104.  
  105. PROCEDURE Calendar.SetYear(Year: Integer);
  106. BEGIN
  107.    ThisYear := Year;
  108. END;
  109.  
  110. FUNCTION Calendar.GetMonth: Integer;
  111. BEGIN
  112.    GetMonth := ThisMonth;
  113. END;
  114.  
  115. FUNCTION Calendar.GetYear: Integer;
  116. BEGIN
  117.    GetYear := ThisYear;
  118. END;
  119.  
  120. DESTRUCTOR Calendar.Done;
  121. BEGIN
  122.    {for dynamic object instances,
  123.      the Done method still works even
  124.      though it contains nothing except
  125.      the destructor declaration          }
  126. END;
  127.  
  128. END.
  129.