unit1.pas

一个小的万年历程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Spin, StdCtrls, Grids, hxCalendar, ActnList;

type
  TForm1 = class(TForm)
    d_set: ThxCalendar;
    year: TSpinEdit;
    month: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    dat: TStaticText;
    s_da: TStaticText;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    procedure yearChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure AcchangExecute(Sender: TObject);
    procedure d_setChange(Sender: TObject);
    procedure monthClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  function DaysPerMonth(AYear, AMonth: Integer): Integer; virtual; {add}
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.yearChange(Sender: TObject);
begin
  if (year.Value>1800) and (year.Value < 3000) then
    d_set.year:=year.Value;
  AcchangExecute(self)
end;

procedure TForm1.FormShow(Sender: TObject);
var
  years:word;
  months:word;
  day:word;
begin
    decodedate(date,years,months,day);
    year.Value:=years;
    d_set.Year:= years;
    month.Value:=months;
    d_set.Month:=months;
    d_set.Day:=day;
end;

procedure TForm1.AcchangExecute(Sender: TObject);
var
  str:string;
  HzDate:THzDate;
begin
    DaysPerMonth(year.Value, month.Value);
    d_set.Month:=month.Value;
    d_set.Year:=year.Value;
    d_set.Month:=month.Value;
    if (month.Value=2)and IsLeapYear(d_set.Year) then
       str:=trim(d_set.FormatLunarYear(d_set.Year)+d_set.FormatLunarMonth(d_set.Month,true) + d_set.FormatLunarDay(d_set.Day))
   else
        str:=trim(d_set.FormatLunarYear(d_set.Year)+d_set.FormatLunarMonth(d_set.Month,false) + d_set.FormatLunarDay(d_set.Day));
  dat.Caption := FormatDateTime('dddddd', d_set.CalendarDate);
  HzDate := d_set.ToLunar(d_set.CalendarDate);
  s_da.Caption :=d_set.cyclical(HzDate.year-1900+36)+d_set.FormatLunarMonth(HzDate.Month,HzDate.isLeap)+d_set.FormatLunarDay(Hzdate.Day);
end;


procedure TForm1.d_setChange(Sender: TObject);
begin
  AcchangExecute(self);
end;

function TForm1.DaysPerMonth(AYear, AMonth: Integer): Integer;

const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30,
    31, 30, 31);
begin
  Result := DaysInMonth[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result);  { leap-year Feb is special }
end;


procedure TForm1.monthClick(Sender: TObject);
begin
   if (month.Value> 0) and (month.Value<13) then
   begin
     DaysPerMonth(year.Value, month.Value);
     if (month.Value=2) and IsLeapYear(d_set.Year)  then
       begin
           d_set.Month:=month.Value;
          d_set.Day:=29;
          d_setChange(self);
        end
       else
         begin
          d_set.Month:=month.Value;
          d_set.Day:=28;
          d_setChange(self);
         end;
      AcchangExecute(self);
    end
  else
    showmessage('你选择的月份无效，请重新选择!!!');

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  years:word;
  months:word;
  day:word;
begin
    decodedate(date,years,months,day);
    year.Value:=years;
    d_set.Year:= years;
    month.Value:=months;
    d_set.Month:=months;
    d_set.Day:=day;
end;

end.