[Back to DATETIME SWAG index]  [Back to Main SWAG index]  [Original]

UNIT CalUnit;
{ Object oriented calander unit }

INTERFACE

USES CRT,DOS;

TYPE
  Calendar = OBJECT
    ThisMonth, ThisYear : Word;
    CONSTRUCTOR Init(Month, Year: Integer);
    PROCEDURE        DrawCalendar;
    PROCEDURE        SetMonth(Month: Integer);
    PROCEDURE        SetYear(Year: Integer);
    FUNCTION        GetMonth: Integer;
    FUNCTION        GetYear: Integer;
    DESTRUCTOR        Done;
  END;

IMPLEMENTATION

CONSTRUCTOR Calendar.Init(Month, Year: Integer);
BEGIN
   SetYear(Year);
   SetMonth(Month);
   DrawCalendar;
END;

PROCEDURE Calendar.DrawCalendar;

VAR
  CurYear,CurMonth,CurDay,CurDow,
  ThisDay,ThisDOW    : Word;
  I,DayPos,NbrDays   : Byte;

CONST
  DOM: ARRAY[1..12] OF Byte =
       (31,28,31,30,31,30,31,31,30,31,30,31);
  MonthName: ARRAY[1..12] OF String[3] =
       ('Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec');

BEGIN

  GetDate(CurYear,CurMonth,CurDay,CurDow);

  {Set to day 1 so we can use GetDate function}
  ThisDay := 1;

  SetDate(ThisYear,ThisMonth,ThisDay);

  {ThisDOW stands for This day of the week}

  GetDate(ThisYear,ThisMonth,ThisDay,ThisDOW);

  SetDate(CurYear,CurMonth,CurDay);

  WriteLn('           ',MonthName[ThisMonth],
          ' ',ThisYear);
  WriteLn;
  WriteLn('   S   M   T   W   R   F   S');

  NbrDays := DOM[ThisMonth];

  {Check for leap year, which occurs when the
   year is evenly divisible by 4 and not evenly
   divisable by 100 or if the year is evenly
   divisable by 400}

  IF ((ThisMonth = 2) AND
     ((ThisYear MOD 4 = 0) AND
      (ThisYear MOD 100 <> 0))
     OR (ThisYear MOD 400 = 0))
   THEN NbrDays := 29;

  FOR I:= 1 TO NbrDays DO
    BEGIN
      DayPos := ThisDOW * 4 + 2;  {Position day #}
      GotoXY(DayPos,WhereY);
      Inc(ThisDOW);
      Write(I:3);
      IF ThisDOW > 6 THEN
        BEGIN
          ThisDOW := 0;
          WriteLn
        END
    END;
    WriteLn
END;

PROCEDURE Calendar.SetMonth(Month: Integer);
BEGIN
   ThisMonth := Month;
   WHILE ThisMonth < 1 DO
   BEGIN
      Dec(ThisYear);
      Inc(ThisMonth, 12);
   END;
   WHILE ThisMonth > 12 DO
   BEGIN
      Inc(ThisYear);
      Dec(ThisMonth, 12);
   END;
END;

PROCEDURE Calendar.SetYear(Year: Integer);
BEGIN
   ThisYear := Year;
END;

FUNCTION Calendar.GetMonth: Integer;
BEGIN
   GetMonth := ThisMonth;
END;

FUNCTION Calendar.GetYear: Integer;
BEGIN
   GetYear := ThisYear;
END;

DESTRUCTOR Calendar.Done;
BEGIN
   {for dynamic object instances,
     the Done method still works even
     though it contains nothing except
     the destructor declaration              }
END;

END.

{ ---------------------------    TEST PROGRAM ---------------------}
PROGRAM CalTest;

USES DOS,CRT,CalUnit;

VAR
   MyCalendar: Calendar;
   TYear,TMonth,Tday,TDOW: Word;

BEGIN
   ClrScr;
   GetDate(TYear,TMonth,Tday,TDOW);
   WITH MyCalendar DO
   BEGIN
      WriteLn('    Current Month''s Calendar');
      WriteLn;
      Init(TMonth, TYear);
      WHILE (TMonth <> 0) DO
        BEGIN
          WriteLn;
          WriteLn('   Enter a Month and Year');
          WriteLn('(Separate values by a space)');
          WriteLn;
          WriteLn('      exm.      3 1990');
          WriteLn;
          Write         ('   or 0 0 to quit: ');
          ReadLn(TMonth, TYear);
          IF TMonth <> 0 THEN
             BEGIN
               ClrScr;
               SetYear(TYear);
               SetMonth(TMonth);
               DrawCalendar
             END
        END
   END;
   ClrScr
END.

[Back to DATETIME SWAG index]  [Back to Main SWAG index]  [Original]