{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                      日历单元                           ***}
{***************************************************************}
{$F+,O+,X+,S-,D-}
Unit FCalenda;
Interface
Uses
  Dos,Graph,FView,FEvent,FGraph,FMouse,FWrite,FTool;

Type

 PCalendarView = ^TCalendarView;
 TCalendarView = object(TView)
   Year, Month, Days: Word;
   CurYear, CurMonth, CurDay : Word;
   Constructor Init(x,y: Integer);
   Procedure HandleEvent(var Event: TEvent); virtual;
   Procedure Paint;virtual;
   Procedure Draw; virtual;
   Procedure MoveTo(x,y:Integer);virtual;
 end;

Function CalendarWindow:PWindow;
Implementation
Const
  WeekStr: array[0..6] of string[2]=
          ('日','一','二','三','四','五','六');

  DaysInMonth: array[1..12] of Byte =
     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

  MonthStr: array[1..12] of string[20] =
     ('一月   January   ',
      '二月   February  ',
      '三月   March     ',
      '四月   April     ',
      '五月   May       ',
      '六月   June      ',
      '七月   July      ',
      '八月   August    ',
      '九月   September ',
      '十月   October   ',
      '十一月 November  ',
      '十二月 December  ');

Function CalendarWindow:PWindow;
var
  R:TRect;
  P:PWindow;
begin
  AssignRect(R, 0, 0, 325, 210);
  P:=New(PWindow,Init(R,'日历',True));
  P^.Option:=P^.Option or opAligen8;
  P^.Insert(New(PButton,Init(270 ,35,285,55,#30,kbUp,cmPrev)));
  P^.Insert(New(PButton,Init(290 ,35,305,55,#31,kbDown,cmNext)));
  P^.Insert(New(PCalendarView, Init(20,61)));
  P^.Next;
  P^.Center;
  CalendarWindow:=P;
end;

{ TCalendarView }
Constructor TCalendarView.Init(x,y:Integer);
var
  H: Word;
begin
  Inherited Init;
  Option:=Option+opCantSelect;
  GetDate(CurYear, CurMonth, CurDay, H);
  Year := CurYear;
  Month := CurMonth;
  Origin.x:=x;
  Origin.y:=y;
  Size.x:=7*40+4;
  Size.y:=7*18+4;
end;

Function DayOfWeek(Day, Month, Year: Integer) : Integer;
var
  Century, Yr, Dw: Integer;
begin
  if Month < 3 then
  begin
    Inc(Month, 10);
    Dec(Year);
  end
  else
     Dec(Month, 2);
  Century := Year div 100;
  Yr := Year mod 100;
  Dw := (((26 * Month - 2) div 10) + Day + Yr + (Yr div 4) +
    (Century div 4) - (2 * Century)) mod 7;
  if Dw < 0 then DayOfWeek := Dw + 7
  else DayOfWeek := Dw;
end;

Procedure TCalendarView.MoveTo;
begin
  Origin.x:=x;
  Origin.y:=y;
end;

Procedure TCalendarView.Paint;
var
  i:Integer;
begin
  HideMouse;
  DrawBroad(Origin.x-2,Origin.y-2,Origin.x+Size.x+2,Origin.y+Size.y+2,0);
  SetColor(0);
  for i:=0 to 7 do
  Line(Origin.x+2+i*40,Origin.y+2,Origin.x+2+i*40,Origin.y+2+7*18);
  for i:=0 to 7 do
  Line(Origin.x+2,Origin.y+2+i*18,Origin.x+2+7*40,Origin.y+2+i*18);
  for i:=0 to 6 do
  signbroad(Origin.x+3+i*40,origin.y+3,origin.x+41+i*40,origin.y+19,1);
  for i:=0 to 6 do
  Writecs(Origin.x+16+i*40,Origin.y+4,WeekStr[i],0);
  Draw;
end;

Procedure TCalendarView.Draw;
const
  Width = 20;
var
  i, j, DayOf, CurDays: Integer;
  S: String;
  B: array[0..Width] of Word;
  Color, BoldColor, SpecialColor: Byte;
  Dlt:Integer;

function Num2Str(I: Integer): String;
var
  S:String;
begin
  Str(i:2, S);
  Num2Str := S;
end;

begin
  HideMouse;
  Full(Origin.x,Origin.y-22,Origin.x+240,Origin.y-5,7);
  Writecs(origin.x,origin.y-22,MonthStr[Month],0);
  Writecs(origin.x+180,origin.y-22,IntStr(Year)+'年',0);
  DayOf := DayOfWeek(1, Month, Year);
  Days := DaysInMonth[Month] + Byte((Year mod 4 = 0) and (Month = 2));
  CurDays := 1 - DayOf;
  for i := 1 to 6 do
  begin
    for j := 0 to 6 do
    begin
      full(Origin.x+16+j*40,Origin.y+4+i*18,Origin.x+32+j*40,Origin.y+18+i*18,7);
      if (CurDays > 0) and (CurDays <= Days) then
      begin
        if CurDays<10 then Dlt:=4 else Dlt:=0;
        { if it is the current day }
        if (Year = CurYear) and (Month = CurMonth) and
          (CurDays = CurDay) then
          Writecs(Origin.x+16+j*40+Dlt,Origin.y+4+i*18,Intstr(CurDays),10)
        else if j=0 then
          Writecs(Origin.x+16+j*40+Dlt,Origin.y+4+i*18,Intstr(CurDays),4)
        else
          Writecs(Origin.x+16+j*40+Dlt,Origin.y+4+i*18,Intstr(CurDays),0);
      end;
      Inc(CurDays);
    end;
  end;
  ShowMouse;
end;

Procedure TCalendarView.HandleEvent(var Event: TEvent);
begin
  Inherited HandleEvent(Event);
  case Event.What of
  evCommand:case Event.Command of
            cmNext:begin
                     Inc(Month);
                     if Month > 12 then
                     begin
                       Inc(Year);
                       Month := 1;
                     end;
                     Draw;
                   end;
            cmPrev:begin
                     Dec(Month);
                     if Month < 1 then
                     begin
                       Dec(Year);
                       Month := 12;
                     end;
                     Draw;
                   end;
            end;
  end;
end;

end.