unit P_Calendar;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  System.DateUtils,
  FMX.Menus,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Layouts, FMX.Edit,
  System.Actions, FMX.ActnList, FMX.Gestures;

type
  TForm_Calendar = class(TForm)
    lay_Calendar: TLayout;
    rect_Year: TRectangle;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Choose_CNday1: TLabel;
    Choose_Box: TRectangle;
    Choose_Day1: TLabel;
    lbl_BackYear: TLabel;
    lbl_BackMonth: TLabel;
    rect_Footer: TRectangle;
    lbl_Star: TLabel;
    lbl_ChnDateShow: TLabel;
    lbl_Vaction: TLabel;
    rect_Today: TEllipse;
    lbl_TodayDay: TLabel;
    lbl_ChooseMonth: TLabel;
    Label11: TLabel;
    lbl_ChooseYear: TLabel;
    Label13: TLabel;
    MenuYear: TPopupMenu;
    MenuMonth: TPopupMenu;
    MenuMonth_1: TMenuItem;
    MenuMonth_2: TMenuItem;
    MenuMonth_3: TMenuItem;
    MenuMonth_4: TMenuItem;
    MenuMonth_5: TMenuItem;
    MenuMonth_6: TMenuItem;
    MenuMonth_7: TMenuItem;
    MenuMonth_8: TMenuItem;
    MenuMonth_9: TMenuItem;
    MenuMonth_10: TMenuItem;
    MenuMonth_11: TMenuItem;
    MenuMonth_12: TMenuItem;
    GestureManager1: TGestureManager;
    ActionList1: TActionList;
    Call_PriorMonth: TAction;
    Call_NextMonth: TAction;
    Call_PriorYear: TAction;
    Call_NextYear: TAction;
    Call_PresentDay: TAction;
    rect_Week: TRectangle;
    Call_DayMouseDown: TAction;
    lay_MonthTouch: TLayout;
    lay_YearTouch: TLayout;
    lay_Choose: TLayout;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Call_PriorMonthExecute(Sender: TObject);
    procedure Call_NextMonthExecute(Sender: TObject);
    procedure Call_PriorYearExecute(Sender: TObject);
    procedure Call_NextYearExecute(Sender: TObject);
    procedure Call_PresentDayExecute(Sender: TObject);
    procedure rect_TodayClick(Sender: TObject);
    procedure Call_DayMouseDownExecute(Sender: TObject);
    procedure Choose_Day1Gesture(Sender: TObject;
      const EventInfo: TGestureEventInfo; var Handled: Boolean);
    procedure Choose_CNday1Gesture(Sender: TObject;
      const EventInfo: TGestureEventInfo; var Handled: Boolean);
    procedure Choose_CNday1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Choose_Day1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Choose_Day1Click(Sender: TObject);
    procedure Choose_CNday1Click(Sender: TObject);
  private
    { Private declarations }
    def_DayHeight: single;
    click_Day: integer;
    procedure LoadLAB;
    procedure DateChange(MyTime: TDateTime);
    procedure YearClick(Sender: TObject);
  public
    { Public declarations }
    FPicture_AlphaBlend: Byte;
    FPicture: TbitMap;
    NDate: Tdate;
    YearEdit, MonthEdit, DayEdit: TEdit;
    ChDateLabel: TLabel;
  end;

var
  Form_Calendar: TForm_Calendar;
   CnDate: array[1..37] of TLabel;
   ChnDate: array[1..37] of TLabel;
   NYear, NMonth, NDay: Word;

implementation

{$R *.fmx}

uses U_DateCn;

function DayOfMonth(Year, Month: Integer): integer; overload;
begin
     try
        result := MonthDays[IsLeapYear(Year), Month];
     except
        result := 0;
     end;
end;

function DayOfMonth(Dates: TDateTime): integer; overload;
         var Year, Month, Day: Word;
begin
     DecodeDate(Dates, Year, Month, day);
     result := MonthDays[IsLeapYear(Year), Month];
end;

function DaysOfMonth(Dates: TDateTime): Integer;
begin
     result := DayOfMonth(YearOf(Dates), MonthOf(Dates));
end;

function SetDateTime(NYear, NMonth, NDay: Word): TDate;
         var MyDay: Word;
begin
     MyDay := DayOfMonth(NYear, NMonth);
     if MyDay < NDay then NDay := MyDay;
     result := EncodeDate(NYear, NMonth, NDay);
end;

procedure TForm_Calendar.LoadLAB;
          var i: integer;
begin
     for i := 1 to 37 do
     begin
        CnDate[i]                 := TLabel.Create(self);
        CnDate[i].parent          := lay_Choose;
        CnDate[i].Touch           := Choose_Day1.Touch;
        CnDate[i].AutoSize        := False;
        CnDate[i].Width           := Choose_Day1.Width;
        CnDate[i].Height          := Choose_Day1.Height;
        CnDate[i].Align           := Choose_Day1.Align;
        CnDate[i].Font            := Choose_Day1.Font;
        CnDate[i].TextSettings    := Choose_Day1.TextSettings;
        CnDate[i].StyledSettings  := Choose_Day1.StyledSettings;
        CnDate[i].HitTest         := True;
        CnDate[i].OnClick         := Choose_Day1Click;
        CnDate[i].OnMouseDown     := Choose_Day1MouseDown;
        CnDate[i].Touch.GestureManager      := GestureManager1;
        CnDate[i].Touch.InteractiveGestures := [TInteractiveGesture.LongTap];
        CnDate[i].OnGesture                 := Choose_Day1Gesture;

        ChnDate[i]                := TLabel.Create(self);
        ChnDate[i].parent         := lay_Choose;
        ChnDate[i].AutoSize       := False;
        ChnDate[i].Width          := Choose_CNday1.Width;
        ChnDate[i].Height         := Choose_CNday1.Height;
        ChnDate[i].Align          := Choose_CNday1.Align;
        ChnDate[i].Font           := Choose_CNday1.Font;
        ChnDate[i].TextSettings   := Choose_CNday1.TextSettings;
        ChnDate[i].StyledSettings := Choose_CNday1.StyledSettings;
        ChnDate[i].HitTest        := True;
        ChnDate[i].OnClick        := Choose_CNday1Click;
        ChnDate[i].OnMouseDown    := Choose_CNday1MouseDown;
        ChnDate[i].Touch.GestureManager      := GestureManager1;
        ChnDate[i].Touch.InteractiveGestures := [TInteractiveGesture.LongTap];
        ChnDate[i].OnGesture                 := Choose_CNday1Gesture;

        if i = 1 then
        begin
           CnDate[i].Position.X  := Choose_Day1.Position.X;
           CnDate[i].Position.Y  := Choose_Day1.Position.Y;
           ChnDate[i].Position.X := Choose_CNday1.Position.X;
           ChnDate[i].Position.Y := Choose_CNday1.Position.Y;
        end
        else begin
           if ((i - 1) mod 7) = 0 then
           begin
              CnDate[i].Position.X  := Choose_Day1.Position.X;
              CnDate[i].Position.Y  := CnDate[i - 1].Position.Y + def_DayHeight;;
              ChnDate[i].Position.X := Choose_CNday1.Position.X;
              ChnDate[i].Position.Y := ChnDate[i - 1].Position.Y + def_DayHeight;;
           end
           else begin
              CnDate[i].Position.X  := CnDate[i - 1].Position.X + 50;
              CnDate[i].Position.Y  := CnDate[i - 1].Position.Y;
              ChnDate[i].Position.X := ChnDate[i - 1].Position.X + 50;
              ChnDate[i].Position.Y := ChnDate[i - 1].Position.Y;
           end;
        end;
     end;
end;

procedure TForm_Calendar.rect_TodayClick(Sender: TObject);
begin
     DateChange(today);
end;

procedure TForm_Calendar.YearClick(Sender: TObject);
          var Present: TDate;
begin
     NYear   := TMenuItem(Sender).Tag;
     Present := SetDateTime(NYear, NMonth, NDay);
     DateChange(Present);
end;

procedure TForm_Calendar.Call_DayMouseDownExecute(Sender: TObject);
         var Present: TDate;
begin
     NDay := CnDate[click_Day].Text.ToInteger;
     Choose_Box.Position.X := CnDate[click_Day].Position.X;
     Choose_Box.Position.Y := CnDate[click_Day].Position.Y;
     Present := SetDateTime(NYear, NMonth, NDay);
     lbl_Star.Text := Constellation(Present, NDay);
     lbl_ChnDateShow.Text := Copy(CnSkyStemOfYear(Present), 1, 2) + '/' +
                             Copy(CnanimalOfYear(Present),1,2)+
                             ' 農:'+CnMonthOfDate(Present)+CnDayOfDate(Present);
     lbl_Vaction.Text := GetLunarHolDay(Present)+CnDayOfDateJr(Present) +
                         Holiday(True, Present,DayOf(Present));
end;

procedure TForm_Calendar.Call_NextMonthExecute(Sender: TObject);
          var Present: TDate;
begin
     try
        NMonth := StrtoInt(lbl_ChooseMonth.Text);
     except
        exit;
     end;

     NMonth := NMonth  + 1;
     if NMonth > 12 then
     begin
        NMonth := 1;
        NYear := NYear + 1;
        if NYear > 2050 then NYear  := 2050;
     end;
     Present := SetDateTime(NYear, NMonth, NDay);
     DateChange(Present);
end;

procedure TForm_Calendar.Call_NextYearExecute(Sender: TObject);
          var Present: TDate;
begin
     try
        NYear := StrtoInt(lbl_ChooseYear.Text);
     except
        exit;
     end;

     NYear := NYear  + 1;
     if NYear >= 2050 then NYear := 2050
     else begin
        Present := SetDateTime(NYear, NMonth, NDay);
        DateChange(Present);
     end;
end;

procedure TForm_Calendar.Call_PresentDayExecute(Sender: TObject);
begin
     DateChange(today);
end;

procedure TForm_Calendar.Call_PriorMonthExecute(Sender: TObject);
          var Present: TDate;
begin
     try
        NMonth := StrtoInt(lbl_ChooseMonth.Text);
     except
        exit;
     end;

     NMonth := NMonth  - 1;
     if NMonth < 1 then
     begin
        NMonth := 12;
        NYear := NYear - 1;
        if NYear < 1901 then NYear  := 1901;
     end;
     Present := SetDateTime(NYear, NMonth, NDay);
     DateChange(Present);
end;

procedure TForm_Calendar.Call_PriorYearExecute(Sender: TObject);
          var Present: TDate;
begin
     try
        NYear := StrtoInt(lbl_ChooseYear.Text);
     except
        exit;
     end;

     NYear := NYear  - 1;
     if NYear <= 1901 then NYear := 1901
     else begin
        Present := SetDateTime(NYear, NMonth, NDay);
        DateChange(Present);
     end;
end;

procedure TForm_Calendar.Choose_CNday1Click(Sender: TObject);
begin
     click_Day := (Sender as TLabel).Tag;
end;

procedure TForm_Calendar.Choose_CNday1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
     case EventInfo.GestureID of
        igiLongTap : Call_DayMouseDownExecute(self);
     end;
end;

procedure TForm_Calendar.Choose_CNday1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
     click_Day := (Sender as TLabel).Tag;
     Call_DayMouseDownExecute(self);
end;

procedure TForm_Calendar.DateChange(MyTime: TDateTime);
          var i, S: integer;
              StarNo: integer;
              Present: TDateTime;
              Year, Month, Day: Word;
              _DayofWeek : word;
begin
     // 如果是同一月份, 就不要重繪該月份日曆
     if (MonthOf(Mytime) = StrtoInt(lbl_ChooseMonth.Text)) and
        (YearOf(Mytime) = StrtoInt(lbl_ChooseYear.Text)) then
     begin
        exit;
     end;

     lbl_ChooseMonth.Text := IntToStr(MonthOf(Mytime));
     lbl_ChooseYear.Text  := IntToStr(YearOf(Mytime));
     lbl_BackYear.Text    := IntToStr(YearOf(Mytime));
     lbl_BackMonth.Text   := lbl_ChooseMonth.Text;
     lbl_ChnDateShow.Text := Copy(CnSkyStemOfYear(Mytime), 1, 2) + '/' +
                             Copy(CnanimalOfYear(Mytime),1,2) +
                             ' 農:'+CnMonthOfDate(Mytime) + CnDayOfDate(Mytime);
     lbl_Vaction.Text     := GetLunarHolDay(Mytime)+CnDayOfDateJr(Mytime) +
                             Holiday(True, Mytime,DayOf(Mytime));

     // 例假日標示
     for i := 1 to 37 do
     begin
        // 先還原預設值
        CnDate[i].Visible    := False;
        CnDate[i].Font.Size  := Choose_Day1.Font.Size;
        CnDate[i].TextSettings.FontColor := Choose_Day1.TextSettings.FontColor;
        ChnDate[i].Visible   := False;
        ChnDate[i].Font.Size := Choose_CNday1.Font.Size;
        ChnDate[i].TextSettings.FontColor := Choose_CNday1.TextSettings.FontColor;

        if (i mod 7 = 0) or (i mod 7 = 1) then
        begin
           CnDate[i].TextSettings.FontColor  := TAlphaColorRec.Red;
           ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Red;
        end
        else begin
           CnDate[i].TextSettings.FontColor  := TAlphaColorRec.Black;
           ChnDate[i].TextSettings.FontColor := Choose_CNday1.TextSettings.FontColor;
        end;
     end;

     DecodeDate(MyTime, Year, Month, Day);
     Present := EncodeDate(Year, Month, 1);
     StarNo  := DayOfWeek(Present);
     s := starno + DayOfMonth(Present) - 1;
     try
        for i := StarNo to s do
        begin
           _DayofWeek := i - StarNo + 1;
           Present := EncodeDate(Year, Month, i - StarNo + 1);
           CnDate[i].Text   := IntToStr(i - StarNo + 1);
           CnDate[i].Tag    := i;
           ChnDate[i].Text  := CnDayOfDate(Present);
           ChnDate[i].Tag   := CnDate[i].Tag;

           if ChnDate[i].Text = '初一' then
           begin
              ChnDate[i].Text := CnMonthOfDate(Present);
              ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Dodgerblue;
           end;

           // 特別節日
           if Holiday(False, MyTime, _DayofWeek) <> '' then
           begin
             if length(Holiday(False, MyTime, _DayofWeek)) > 3
             then ChnDate[i].Font.Size := 10
             else ChnDate[i].Font.Size := Choose_CNday1.Font.Size;
             ChnDate[i].Text := Holiday(False, MyTime, _DayofWeek);
             ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Firebrick;
           end;

           // 國定假日
           if HolidayV(False, MyTime, _DayofWeek) <> '' then
           begin
             if length(HolidayV(False, MyTime, _DayofWeek)) > 3
             then ChnDate[i].Font.Size := 10
             else ChnDate[i].Font.Size := Choose_CNday1.Font.Size;
             ChnDate[i].Text := HolidayV(False, MyTime, _DayofWeek);
             ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Red;
           end;

           // 節氣
           if U_DateCn.GetLunarHolDay(Present) <> '' then
           begin
             ChnDate[i].Text := GetLunarHolDay(Present);
             ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Dodgerblue;
           end;

           // 民俗節日
           if U_DateCn.CnDayOfDateJr(Present) <> '' then
           begin
             ChnDate[i].Text := CnDayOfDateJr(Present);
             ChnDate[i].TextSettings.FontColor := TAlphaColorRec.Firebrick;
           end;

           if i - StarNo + 1 = day then
           begin
              Choose_Box.Position.X := CnDate[i].Position.X;
              Choose_Box.Position.Y := CnDate[i].Position.Y;
              lbl_Star.Text         := Constellation(Present, day);
           end;
           CnDate[i].Visible  := True;
           ChnDate[i].Visible := True;
        end;
     except
        on EConvertError do
        begin
          exit;
        end;
     end;
end;

procedure TForm_Calendar.Choose_Day1Click(Sender: TObject);
begin
     click_Day := (Sender as TLabel).Tag;
end;

procedure TForm_Calendar.Choose_Day1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
     case EventInfo.GestureID of
        igiLongTap : Call_DayMouseDownExecute(self);
     end;
end;

procedure TForm_Calendar.Choose_Day1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
     click_Day := (Sender as TLabel).Tag;
     Call_DayMouseDownExecute(self);
end;

procedure TForm_Calendar.FormCreate(Sender: TObject);
          var i, x, y: Integer;
              d: TDate;
              MenuItem, ChildMenuItem: TMenuItem;
begin
     // 設定日期格式
     FormatSettings.LongTimeFormat  := 'HH:mm:ss';
     // 請注意, 本處的 MM 必須大寫, 才能改變控制台中的區域日期設定
     FormatSettings.ShortDateFormat :='yyyy/MM/dd';
     FormatSettings.DateSeparator   :='/';

     d := StrToDate('2004/01/01');
     for i := 1 to 12 do
     begin
        TMenuItem(FindComponent('MenuMonth_' + IntToStr(i))).Text := FormatDateTime('mmmm', d);
        d := IncMonth(d);
     end;

     x := 1901;
     i := 0;
     (*
     while x <= 2050 do
     begin
        MenuItem := NewItem(IntToStr(x - 1),0, False, True, nil, 0, 'MenuYear_' + IntToStr(x - 1));
        MenuYear.Items.Add(MenuItem);
        y := x;
        while y < x + 10 do
        begin
           ChildMenuItem := NewItem(IntToStr(y), 0, False, True, YearClick, 0, 'MenuYear_' + IntToStr(y));
           ChildMenuItem.Tag := y;
           MenuYear.Items[i].Add(ChildMenuItem);
           Inc(y);
        end;
        x := x + 10;
        Inc(i);
     end;
     *)
     def_DayHeight := 40;
     LoadLAB;
     NDate := Date;
end;

procedure TForm_Calendar.FormShow(Sender: TObject);
begin
     DecodeDate(NDate, NYear, NMonth, NDay);
     DateChange(NDate);
end;

end.
