calendf.pas

农历公历转换组件,可以进行公历转农历,支干历,农历转公历的转换

{ Copyright (c) 2004 by Delphi 7 - Lu XiaoGuang V1.0 }

unit CalendF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, Spin, TransDate, DateUtils;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    SpinEdit4: TSpinEdit;
    SpinEdit5: TSpinEdit;
    SpinEdit6: TSpinEdit;
    Edit3: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    CheckBox1: TCheckBox;
    Edit11: TEdit;
    Label7: TLabel;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Label9: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    CheckBox2: TCheckBox;
    TransDate1: TTransDate;
    TransDate2: TTransDate;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpinButton6DownClick(Sender: TObject);
    procedure SpinButton6UpClick(Sender: TObject);
    procedure SpinButton5DownClick(Sender: TObject);
    procedure SpinButton5UpClick(Sender: TObject);
    procedure SpinButton4DownClick(Sender: TObject);
    procedure SpinButton4UpClick(Sender: TObject);
    procedure SpinButton3DownClick(Sender: TObject);
    procedure SpinButton3UpClick(Sender: TObject);
    procedure SpinButton2DownClick(Sender: TObject);
    procedure SpinButton2UpClick(Sender: TObject);
    procedure SpinButton1DownClick(Sender: TObject);
    procedure SpinButton1UpClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure TransDate2Change(Sender: TObject);
    procedure SpinEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpinEdit4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    MDays: Integer;
    procedure ShowDate;
    procedure ShowLunarDate;
  end;

var
  Form1: TForm1;
  FSet: TFormatSettings;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  A, B, C: WORD;
begin
  GetLocaleFormatSettings(GetUserDefaultLCID, FSet);
  SpinEdit6.Button.OnDownClick := SpinButton6DownClick;
  SpinEdit6.Button.OnUpClick := SpinButton6UpClick;
  SpinEdit5.Button.OnDownClick := SpinButton5DownClick;
  SpinEdit5.Button.OnUpClick := SpinButton5UpClick;
  SpinEdit4.Button.OnDownClick := SpinButton4DownClick;
  SpinEdit4.Button.OnUpClick := SpinButton4UpClick;
  SpinEdit3.Button.OnDownClick := SpinButton3DownClick;
  SpinEdit3.Button.OnUpClick := SpinButton3UpClick;
  SpinEdit2.Button.OnDownClick := SpinButton2DownClick;
  SpinEdit2.Button.OnUpClick := SpinButton2UpClick;
  SpinEdit1.Button.OnDownClick := SpinButton1DownClick;
  SpinEdit1.Button.OnUpClick := SpinButton1UpClick;
  TransDate1.Date := Date;
  DecodeDate(Date, A, B, C);
  SpinEdit1.Value := A;
  SpinEdit2.Value := B;
  SpinEdit3.Value := C;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  SpinEdit4.Value := TransDate1.LunarDate.lYear;
  SpinEdit5.Value := TransDate1.LunarDate.lMonth;
  SpinEdit6.Value := TransDate1.LunarDate.lDay;
  ShowDate;
  ShowLunarDate;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TForm1.ShowDate;
begin
  TransDate1.Date := EncodeDate(SpinEdit1.Value, SpinEdit2.Value, SpinEdit3.Value);
  with TransDate1, TransDate1.LunarDate do
  begin
    Edit1.Text := LunarDateToStr + ' ' + FormatDateTime('dddd', TransDate1.Date, FSet);
    Edit6.Text := Constellation;
    Edit2.Text := Format('%s年 %s月 %s日', [cYear, cMonth, cDay]);
    Edit4.Text := AnimalYear + '年';
    Edit5.Text := SolarTerm;
    if (Copy(Feast, 0, 2) = '复') or (Copy(Feast, 0, 2) = '感') then
      Edit11.Font.Color := clRed
    else
      Edit11.Font.Color := clMaroon;
    Edit11.Text := Feast;
    Edit12.Text := FeastOfLunar;
  end;
end;

procedure TForm1.ShowLunarDate;
const
  SetColor: array[Boolean] of DWORD = (clMaroon, clRed);
var
  D: TDateTime;
begin
  with TransDate2, TransDate2.LunarDate do
  begin
    lYear := SpinEdit4.Value;
    lMonth := SpinEdit5.Value;
    lDay := SpinEdit6.Value;
    CheckBox1.Font.Color := SetColor[TransDate2.LunarDate.FlagLeapMonth];
    D := TransDate2.Date;
    Edit3.Text := FormatDateTime('dddddd', D, FSet) + ' ' + FormatDateTime('dddd', D, FSet);
    Edit10.Text := Constellation;
    Edit7.Text := Format('%s年 %s月 %s日', [cYear, cMonth, cDay]);
    Edit8.Text := AnimalYear + '年';
    Edit9.Text := SolarTerm;
    if (Copy(Feast, 0, 2) = '复') or (Copy(Feast, 0, 2) = '感') then
      Edit13.Font.Color := clRed
    else
      Edit13.Font.Color := clMaroon;
    Edit13.Text := Feast;
    Edit14.Text := FeastOfLunar;
  end;
end;

procedure TForm1.SpinButton1DownClick(Sender: TObject);
begin
  if (SpinEdit1.Value > StartYear) and (SpinEdit1.Value <= EndYear) then
  begin
    SpinEdit1.Value := SpinEdit1.Value - 1;
    MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
    if SpinEdit3.Value >= MDays then
    begin
      SpinEdit3.Value := MDays;
    end;
    ShowDate;
  end;
end;

procedure TForm1.SpinButton1UpClick(Sender: TObject);
begin
  if (SpinEdit1.Value >= StartYear) and (SpinEdit1.Value < EndYear) then
  begin
    SpinEdit1.Value := SpinEdit1.Value + 1;
    MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
    if SpinEdit3.Value >= MDays then
      SpinEdit3.Value := MDays;
    ShowDate;
  end;
end;

procedure TForm1.SpinButton2DownClick(Sender: TObject);
begin
  if SpinEdit2.Value <= 1 then
  begin
    SpinEdit2.Value := 12;
    SpinEdit1.Value := SpinEdit1.Value - 1;
    MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
    if SpinEdit3.Value > MDays then
    begin
      SpinEdit3.Value := MDays;
    end;
  end
  else
    SpinEdit2.Value := SpinEdit2.Value - 1;
  ShowDate;
end;

procedure TForm1.SpinButton2UpClick(Sender: TObject);
begin
  if SpinEdit2.Value >= 12 then
  begin
    SpinEdit2.Value := 1;
    SpinEdit1.Value := SpinEdit1.Value + 1;
  end
  else
    SpinEdit2.Value := SpinEdit2.Value + 1;
  MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
  if SpinEdit3.Value > MDays then
  begin
    SpinEdit3.Value := MDays;
  end;
  ShowDate;
end;

procedure TForm1.SpinButton3DownClick(Sender: TObject);
begin
  if SpinEdit3.Value <= 1 then
  begin
    if SpinEdit2.Value <= 1 then
    begin
      SpinEdit2.Value := 12;
      SpinEdit1.Value := SpinEdit1.Value - 1;
    end
    else
      SpinEdit2.Value := SpinEdit2.Value - 1;
    MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
    SpinEdit3.Value := MDays;
  end
  else
    SpinEdit3.Value := SpinEdit3.Value - 1;
  ShowDate;
end;

procedure TForm1.SpinButton3UpClick(Sender: TObject);
begin
  MDays := DaysInAMonth(SpinEdit1.Value, SpinEdit2.Value);
  if SpinEdit3.Value >= MDays then
  begin
    if SpinEdit2.Value >= 12 then
    begin
      SpinEdit2.Value := 1;
      SpinEdit1.Value := SpinEdit1.Value + 1;
    end
    else
      SpinEdit2.Value := SpinEdit2.Value + 1;
    SpinEdit3.Value := 1;
  end
  else
    SpinEdit3.Value := SpinEdit3.Value + 1;
  ShowDate;
end;

procedure TForm1.SpinButton4DownClick(Sender: TObject);
begin
  if (SpinEdit4.Value >= StartYear) and (SpinEdit4.Value <= EndYear) then
  begin
    SpinEdit4.Value := SpinEdit4.Value - 1;
    MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
    if SpinEdit6.Value >= MDays then
      SpinEdit6.Value := MDays;
    ShowLunarDate;
  end;
end;

procedure TForm1.SpinButton4UpClick(Sender: TObject);
begin
  if (SpinEdit4.Value >= StartYear) and (SpinEdit4.Value <= EndYear) then
  begin
    SpinEdit4.Value := SpinEdit4.Value + 1;
    MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
    if SpinEdit6.Value >= MDays then
      SpinEdit6.Value := MDays;
    ShowLunarDate;
  end;
end;

procedure TForm1.SpinButton5DownClick(Sender: TObject);
begin
  if SpinEdit5.Value <= 1 then
  begin
    SpinEdit5.Value := 12;
    SpinEdit4.Value := SpinEdit4.Value - 1;
    MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
    if SpinEdit6.Value > MDays then
    begin
      SpinEdit6.Value := MDays;
    end;
  end
  else
  begin
    with TransDate2.LunarDate do
    begin
      if ((lMonth - 1) = GetLeapMonth(lYear)) then
      begin
        SpinEdit5.Value := SpinEdit5.Value - 1;
        if not FlagLeapMonth then
        begin
          FlagLeapMonth := True;
          CheckBox1.Checked := True;
        end;
      end
      else
      begin
        if FlagLeapMonth then
        begin
          FlagLeapMonth := False;
          CheckBox1.Checked := False;
        end
        else
          SpinEdit5.Value := SpinEdit5.Value - 1;
      end;
    end;
  end;
  ShowLunarDate;
end;

procedure TForm1.SpinButton5UpClick(Sender: TObject);
begin
  if SpinEdit5.Value >= 12 then
  begin
    SpinEdit5.Value := 1;
    SpinEdit4.Value := SpinEdit4.Value + 1;
    MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
    if SpinEdit6.Value > MDays then
    begin
      SpinEdit6.Value := MDays;
    end;
  end
  else
  begin
    with TransDate2.LunarDate do
    begin
      if (lMonth = GetLeapMonth(lYear)) and (not FlagLeapMonth) then
      begin
        if not FlagLeapMonth then
        begin
          FlagLeapMonth := True;
          CheckBox1.Checked := True;
        end;
      end
      else
      begin
        if FlagLeapMonth then
        begin
          FlagLeapMonth := False;
          CheckBox1.Checked := False;
        end;
        SpinEdit5.Value := SpinEdit5.Value + 1;
      end;
    end;
  end;
  ShowLunarDate;
end;

procedure TForm1.SpinButton6DownClick(Sender: TObject);
begin
  if SpinEdit6.Value <= 1 then
  begin
    if SpinEdit5.Value <= 1 then
    begin
      SpinEdit5.Value := 12;
      SpinEdit4.Value := SpinEdit4.Value - 1;
    end
    else
    begin
      with TransDate2.LunarDate do
      begin
        if ((lMonth - 1) = GetLeapMonth(lYear)) then
        begin
          if not FlagLeapMonth then
          begin
            FlagLeapMonth := True;
            CheckBox1.Checked := True;
          end;
          SpinEdit5.Value := SpinEdit5.Value - 1;
        end
        else
        begin
          if FlagLeapMonth then
          begin
            FlagLeapMonth := False;
            CheckBox1.Checked := False;
          end
          else
            SpinEdit5.Value := SpinEdit5.Value - 1;
        end;
      end;
    end;
    MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
    SpinEdit6.Value := MDays;
  end
  else
    SpinEdit6.Value := SpinEdit6.Value - 1;
  ShowLunarDate;
end;

procedure TForm1.SpinButton6UpClick(Sender: TObject);
begin
  MDays := TransDate2.LunarDate.GetMonthDays(SpinEdit4.Value, SpinEdit5.Value);
  if SpinEdit6.Value >= MDays then
  begin
    if SpinEdit5.Value >= 12 then
    begin
      SpinEdit5.Value := 1;
      SpinEdit4.Value := SpinEdit4.Value + 1;
    end
    else
    begin
      with TransDate2.LunarDate do
      begin
        if (lMonth = GetLeapMonth(lYear)) and (not FlagLeapMonth) then
        begin
          if not FlagLeapMonth then
          begin
            FlagLeapMonth := True;
            CheckBox1.Checked := True;
          end;
        end
        else
        begin
          if FlagLeapMonth then
          begin
            FlagLeapMonth := False;
            CheckBox1.Checked := False;
          end;
          SpinEdit5.Value := SpinEdit5.Value + 1;
        end;
      end;
    end;
    SpinEdit6.Value := 1;
  end
  else
    SpinEdit6.Value := SpinEdit6.Value + 1;
  ShowLunarDate;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    TransDate2.LeapMonth := True
  else
    TransDate2.LeapMonth := False;
  ShowLunarDate;
end;

procedure TForm1.TransDate2Change(Sender: TObject);
begin
  if SpinEdit6.Value > TransDate2.LunarDate.MaxMonthDays then
    SpinEdit6.Value := TransDate2.LunarDate.MaxMonthDays;
end;

procedure TForm1.SpinEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    if Sender is TSpinEdit then
    begin
      case (Sender as TSpinEdit).TabOrder of
        0: SpinEdit2.SetFocus;
        1: SpinEdit3.SetFocus;
        2: SpinEdit1.SetFocus;
      end;
      ShowDate;
    end;
  end;
end;

procedure TForm1.SpinEdit4KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    if Sender is TSpinEdit then
    begin
      case (Sender as TSpinEdit).TabOrder of
        0: SpinEdit5.SetFocus;
        1: SpinEdit6.SetFocus;
        2: SpinEdit4.SetFocus;
      end;
      ShowLunarDate;
    end;
  end;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
const
  CBLable: array[Boolean] of string = ('干支历以农历年月为基准', '干支历以节气为基准');
begin
  CheckBox2.Caption := CBLable[CheckBox2.Checked];
  TransDate1.BookOfChanges := CheckBox2.Checked;
  TransDate2.BookOfChanges := CheckBox2.Checked;
  ShowDate;
  ShowLunarDate;
end;

end.