//download by http://www.codefans.net
unit DateWin;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, DateUtils, Menus, ComCtrls, Vcl.Buttons;

type
  TFRM_Date = class(TForm)
    panel1: TPanel;
    Shape1: TShape;
    Bevel2: TBevel;
    shap_ChooseBox: TShape;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Cnday: TLabel;
    Label18: TLabel;
    Label22: TLabel;
    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;
    MenuYear: TPopupMenu;
    lbl_ChnDateShow: TLabel;
    lbl_Vaction: TLabel;
    lbl_NowDay: TLabel;
    shp1: TShape;
    day1: TLabel;
    lbl_BackMonth: TLabel;
    lbl_BackYear: TLabel;
    Label9: TLabel;
    Shape3: TShape;
    lbl_ChooseYear: TLabel;
    btn_NextMonth: TBitBtn;
    btn_PriorMonth: TBitBtn;
    lbl_ChooseMonth: TLabel;
    btn_PriorYear: TBitBtn;
    btn_NextYear: TBitBtn;
    procedure CnDayClick(Sender: TObject);
    procedure CHnDayClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure CnDayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ChnDateMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MenuMonth_1Click(Sender: TObject);
    procedure lbl_NowDayClick(Sender: TObject);
    procedure image_todayClick(Sender: TObject);
    procedure cbx_ChooseMonthCloseUp(Sender: TObject);
    procedure btn_PriorMonthClick(Sender: TObject);
    procedure btn_NextMonthClick(Sender: TObject);
    procedure btn_PriorYearClick(Sender: TObject);
    procedure btn_NextYearClick(Sender: TObject);
  private
    { Private declarations }
    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;
    procedure ShowDateWin(YearEdit1, MonthEdit1, DayEdit1: TEdit; {ChDateLabel1: TLabel;} HostControl: TControl; Bmp: TBitMap = nil; iAlphaBlend: Byte = 150);
  end;

var
   FRM_Date: TFRM_Date;
   CnDate: array[1..37] of TLabel;
   ChnDate: array[1..37] of TLabel;
   NYear, NMonth, NDay: Word;
   MHostControl: TControl;

implementation

uses DateCn;

{$R *.DFM}

function FormExists(FORM_NAME: string): boolean;
begin
     if Application.FindComponent(FORM_NAME) = nil
     then result := False
     else result := True;
end;

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 TFRM_Date.LoadLAB;
          var i: integer;
begin
     for i := 1 to 37 do
     begin
        CnDate[i]              := TLabel.Create(self);
        CnDate[i].parent       := Panel1;
        CnDate[i].OnClick      := CnDayClick;
        CnDate[i].OnMouseDown  := CnDayMouseDown;
        CnDate[i].AutoSize     := False;
        CnDate[i].Width        := day1.Width;
        CnDate[i].Height       := day1.Height;
        CnDate[i].Alignment    := day1.Alignment;
        CnDate[i].Layout       := day1.Layout;

        ChnDate[i]             := TLabel.Create(self);
        ChnDate[i].parent      := Panel1;
        ChnDate[i].OnClick     := ChnDayClick;
        ChnDate[i].OnMouseDown := ChnDateMouseDown;
        ChnDate[i].AutoSize    := False;
        ChnDate[i].Width       := Cnday.Width;
        ChnDate[i].Height      := Cnday.Height;
        ChnDate[i].Alignment   := Cnday.Alignment;
        ChnDate[i].Layout      := Cnday.Layout;

        if i = 1 then
        begin
           CnDate[i].Left  := day1.Left;
           CnDate[i].Top   := day1.Top;
           ChnDate[i].Left := Cnday.Left;
           ChnDate[i].Top  := Cnday.Top;
        end
        else begin
           if ((i - 1) mod 7) = 0 then
           begin
              CnDate[i].Top   := CnDate[i - 1].Top + 42;
              CnDate[i].Left  := day1.Left;
              ChnDate[i].Top  := ChnDate[i - 1].Top + 42;
              ChnDate[i].Left := Cnday.Left;
           end
           else begin
              CnDate[i].Top   := CnDate[i - 1].Top;
              CnDate[i].Left  := CnDate[i - 1].Left + 54;
              ChnDate[i].Top  := ChnDate[i - 1].Top;
              ChnDate[i].Left := ChnDate[i - 1].Left + 54;
           end;
        end;
        CnDate[i].Font         := day1.Font;
        ChnDate[i].Font        := Cnday.Font;
        CnDate[i].Font.Color   := day1.Font.Color;
        CnDate[i].AutoSize     := False;
        ChnDate[i].AutoSize    := False;
        CnDate[i].Transparent  := True;
        ChnDate[i].Transparent := True;
     end;
end;

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

     lbl_ChooseMonth.Caption := IntToStr(DateUtils.MonthOf(Mytime));
     lbl_ChooseYear.Caption  := IntToStr(DateUtils.YearOf(Mytime));
     lbl_BackYear.Caption    := IntToStr(DateUtils.YearOf(Mytime));
     lbl_BackMonth.Caption   := lbl_ChooseMonth.Caption;
     lbl_ChnDateShow.Caption := Copy(CnSkyStemOfYear(Mytime), 1, 2) + '/' +
                                Copy(CnanimalOfYear(Mytime),1,2) +
                                ' 農:'+CnMonthOfDate(Mytime) + CnDayOfDate(Mytime);
     lbl_Vaction.Caption := GetLunarHolDay(Mytime)+CnDayOfDateJr(Mytime)+Holiday(Mytime,DayOf(Mytime));
     for i := 1 to 37 do
     begin
        CnDate[i].Visible := False;
        ChnDate[i].Visible := False;
        CnDate[i].Font.Size := 11;
        CnDate[i].Color := self.Color;
        ChnDate[i].Color := self.Color;
        if (((i) mod 7) = 0) or (((i) mod 7) = 1) then
        begin
           CnDate[i].Font.Color := clRed;
           ChnDate[i].Font.Color := clRed;
        end
        else begin
           CnDate[i].Font.Color := clBlack;
           ChnDate[i].Font.Color := Cnday.Font.Color;
        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
           Present := EncodeDate(Year, Month, i - StarNo + 1);
           CnDate[i].Caption := IntToStr(i - StarNo + 1);
           CnDate[i].Tag := i - StarNo + 1;
           ChnDate[i].Tag := CnDate[i].Tag;
           ChnDate[i].Caption := CnDayOfDate(Present);
           if ChnDate[i].Caption = '初一' then
           begin
              ChnDate[i].Caption := CnMonthOfDate(Present);
              ChnDate[i].Font.Color := clRed;
           end;
           if length(Holiday(MyTime, i - StarNo + 1)) > 3 then
           begin
             ChnDate[i].Caption := Holiday(MyTime, i - StarNo + 1);
             ChnDate[i].Font.Color := $000080FF;
           end;
           if DateCn.GetLunarHolDay(Present) <> '' then
           begin
             ChnDate[i].Caption := GetLunarHolDay(Present);
             ChnDate[i].Font.Color := $00FF5353;
           end;
           if DateCn.CnDayOfDateJr(Present) <> '' then
           begin
             ChnDate[i].Caption := CnDayOfDateJr(Present);
             ChnDate[i].Font.Color := $000080FF;
           end;
           if i - StarNo + 1 = day then
           begin
              shap_ChooseBox.Left := CnDate[i].Left - 2;
              shap_ChooseBox.Top := CnDate[i].Top - 3;
              Label22.Caption := Constellation(Present, day);
           end;
           CnDate[i].Visible  := True;
           ChnDate[i].Visible := True;
        end;
     except
        on EConvertError do
        begin
          exit;
        end;
     end;
end;

procedure TFRM_Date.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))).Caption := 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;
     LoadLAB;
     NDate := Date;
end;

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

procedure TFRM_Date.image_todayClick(Sender: TObject);
begin
     DateChange(today);
end;

procedure TFRM_Date.lbl_NowDayClick(Sender: TObject);
begin
     DateChange(today);
end;

procedure TFRM_Date.CHnDayClick(Sender: TObject);
begin
     Nday := (sender as TLabel).Tag;
end;

procedure TFRM_Date.CnDayClick(Sender: TObject);
begin
     Nday := (sender as TLabel).Tag;
end;

procedure TFRM_Date.FormDeactivate(Sender: TObject);
begin
     Self.Close;
end;

procedure TFRM_Date.btn_NextYearClick(Sender: TObject);
          var Present: TDate;
begin
     try
        NYear := StrtoInt(lbl_ChooseYear.Caption);
     except
        exit;
     end;

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

procedure TFRM_Date.btn_NextMonthClick(Sender: TObject);
          var Present: TDate;
begin
     try
        NMonth := StrtoInt(lbl_ChooseMonth.Caption);
     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 TFRM_Date.btn_PriorYearClick(Sender: TObject);
          var Present: TDate;
begin
     try
        NYear := StrtoInt(lbl_ChooseYear.Caption);
     except
        exit;
     end;

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

procedure TFRM_Date.btn_PriorMonthClick(Sender: TObject);
          var Present: TDate;
begin
     try
        NMonth := StrtoInt(lbl_ChooseMonth.Caption);
     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 TFRM_Date.cbx_ChooseMonthCloseUp(Sender: TObject);
          var Present: TDate;
begin
     NMonth  := TMenuItem(Sender).Tag;
     Present := SetDateTime(NYear, NMonth, NDay);
     DateChange(Present);
end;

procedure TFRM_Date.ChnDateMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
         var Present: TDate;
begin
     shap_ChooseBox.Left     := (sender as TLabel).Left - 2;
     shap_ChooseBox.Top      := (sender as TLabel).Top - 17;
     Nday                    := (sender as TLabel).Tag;
     Present                 := SetDateTime(NYear, NMonth, NDay);
     Label22.Caption         := Constellation(Present, NDay);
     lbl_ChnDateShow.Caption := Copy(CnSkyStemOfYear(Present), 1, 2) + '/' +
                                Copy(CnanimalOfYear(Present),1,2)+
                                ' 農:'+CnMonthOfDate(Present)+CnDayOfDate(Present);
     lbl_Vaction.Caption := GetLunarHolDay(Present)+CnDayOfDateJr(Present)+Holiday(Present,DayOf(Present));
end;

procedure TFRM_Date.CnDayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
         var Present: TDate;
begin
     shap_ChooseBox.Left := (sender as TLabel).Left - 2;
     shap_ChooseBox.Top  := (sender as TLabel).Top - 3;
     Nday := (sender as TLabel).Tag;
     Present := SetDateTime(NYear, NMonth, NDay);
     Label22.Caption := Constellation(Present, NDay);
     lbl_ChnDateShow.Caption := Copy(CnSkyStemOfYear(Present), 1, 2) + '/' +
                                Copy(CnanimalOfYear(Present),1,2)+
                                ' 農:'+CnMonthOfDate(Present)+CnDayOfDate(Present);
     lbl_Vaction.Caption := GetLunarHolDay(Present)+CnDayOfDateJr(Present)+Holiday(Present,DayOf(Present));
end;

procedure TFRM_Date.ShowDateWin(YearEdit1, MonthEdit1, DayEdit1: TEdit;
  HostControl: TControl; Bmp: TBitMap = nil; iAlphaBlend: Byte = 150);
begin
end;

procedure TFRM_Date.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     Application.RemoveComponent(Self);
     Self := nil;
     Self.Free;
end;

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

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

end.

