unit1.pas

是一个免费并开源的支持农历的月历控件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, LssCalendar, ComCtrls, ExtCtrls, StdCtrls, DateUtils, jpeg,
  ImgList, Shellapi, Spin;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    LunarComboBox: TComboBox;
    Image1: TImage;
    Label4: TLabel;
    FtvComboBox: TComboBox;
    Label5: TLabel;
    Label6: TLabel;
    Button1: TButton;
    DateTimePicker1: TDateTimePicker;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    MonthComboBox: TComboBox;
    YearComboBox: TComboBox;
    Image2: TImage;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    CheckBox12: TCheckBox;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Edit3: TEdit;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    Label11: TLabel;
    AddFtvButton: TButton;
    DelFtvButton: TButton;
    ColorBox1: TColorBox;
    GroupBox2: TGroupBox;
    Label12: TLabel;
    Edit4: TEdit;
    ComboBox2: TComboBox;
    AddMarkButton: TButton;
    DelMarkButton: TButton;
    ColorBox2: TColorBox;
    Edit5: TEdit;
    Label13: TLabel;
    Label14: TLabel;
    Panel2: TPanel;
    Label15: TLabel;
    LssCalendar: TLssCalendar;
    CheckBox13: TCheckBox;
    procedure DateTimePicker1Change(Sender: TObject);
    procedure lsscalendarChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure LunarComboBoxChange(Sender: TObject);
    procedure FtvComboBoxChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure YearComboBoxChange(Sender: TObject);
    procedure MonthComboBoxChange(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure CheckBox7Click(Sender: TObject);
    procedure CheckBox8Click(Sender: TObject);
    procedure CheckBox9Click(Sender: TObject);
    procedure CheckBox10Click(Sender: TObject);
    procedure CheckBox11Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure CheckBox12Click(Sender: TObject);
    procedure AddFtvButtonClick(Sender: TObject);
    procedure DelFtvButtonClick(Sender: TObject);
    procedure AddMarkButtonClick(Sender: TObject);
    procedure DelMarkButtonClick(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure CheckBox13Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DateTimePicker1Change(Sender: TObject);
var
  Year, Month, Day: Word;
begin
  DecodeDate(DateTimePicker1.Date, Year, Month, Day);
  if (Year > 2100) or (Year < 1900) then
    Exit;
  //lsscalendar.Date := DateTimePicker1.Date;
  lsscalendar.Year := Year;
  lsscalendar.Month := Month;
  lsscalendar.Day := Day;
end;

procedure TForm1.lsscalendarChange(Sender: TObject);
var
  HzDate:THzDate;
  GzDate:TGzDate;
begin
  label1.caption := '公历：'+ FormatDateTime('yyyy年m月d日 dddd',lsscalendar.Date) + '  第' + IntToStr(lsscalendar.WeekOfYear(lsscalendar.Date)) + '周 ';
  label14.Caption := lsscalendar.Constellation(lsscalendar.Date) + '   '; // + ' --- ' + IntToStr(lsscalendar.DayOfTheWeek(lsscalendar.Date)) + ' ' + IntToStr(lsscalendar.WeekOfTheYear(lsscalendar.Date)) + '/' + IntToStr(lsscalendar.WeeksInYear(lsscalendar.Date));

  Hzdate:=lsscalendar.ToLunar(lsscalendar.Date);
  label2.caption := '农历：'+lsscalendar.FormatLunarYear(hzdate.Year)
           +lsscalendar.FormatLunarMonth(hzdate.Month,lsscalendar.IsRightToLeft)+
           lsscalendar.FormatLunarDay(hzdate.Day) + '    ';

  Gzdate := lsscalendar.GetGz(lsscalendar.Date);
  label3.caption := '干支：' + lsscalendar.Cyclical(GZdate.Year) + '(' + lsscalendar.GetAnimal(GzDate.year) +
          ')年' + lsscalendar.Cyclical(GzDate.Month) + '月'
          + lsscalendar.Cyclical(Gzdate.day) + '日    ';

  label15.Caption := '节日：' + lsscalendar.GetFtv(lsscalendar.Date) + '     ';

  DateTimePicker1.Date := LssCalendar.Date;
  YearComboBox.ItemIndex := YearComboBox.Items.IndexOf(IntToStr(LssCalendar.Year));
  MonthComboBox.ItemIndex := MonthComboBox.Items.IndexOf(IntToStr(LssCalendar.Month));
  if (LssCalendar.Month >= 5) and (LssCalendar.Month <= 10) then
    LssCalendar.BackImage := Image1
  else
    LssCalendar.BackImage := Image2;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  lsscalendar.Date :=Date;
  YearComboBox.ItemIndex := YearComboBox.Items.IndexOf(IntToStr(LssCalendar.Year));
  MonthComboBox.ItemIndex := MonthComboBox.Items.IndexOf(IntToStr(LssCalendar.Month));
  if (LssCalendar.Month >= 5) and (LssCalendar.Month <= 10) then
    LssCalendar.BackImage := Image1
  else
    LssCalendar.BackImage := Image2;

  //load节日表
  with LssCalendar.FtvList do
  begin
    clearAll();
    for i := 0  to length(sFtv) - 1  do
      addFestival(0, copy(sFtv[i],1,4), Trim(copy(sFtv[i],6,length(sFtv[i])-5)), clPurple);
    for i := 0  to length(lFtv) - 1  do
      addFestival(1, copy(lFtv[i],1,4), Trim(copy(lFtv[i],6,length(lFtv[i])-5)), clRed);
    for i := 0  to length(wFtv) - 1  do
      addFestival(2, copy(wFtv[i],1,4), Trim(copy(wFtv[i],6,length(wFtv[i])-5)), clGreen);
  end;
  lsscalendarChange(self);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  lsscalendar.ChineseEar := CheckBox1.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  lsscalendar.SmoothText := CheckBox2.Checked;
end;

procedure TForm1.LunarComboBoxChange(Sender: TObject);
begin
  case LunarComboBox.ItemIndex of
    0:  lsscalendar.LunarCalStyle := csBottom;
    1:  lsscalendar.LunarCalStyle := csNone;
    2:  lsscalendar.LunarCalStyle := csRight;
  end;
end;

procedure TForm1.FtvComboBoxChange(Sender: TObject);
begin
  case FtvComboBox.ItemIndex of
    0:  lsscalendar.FtvCalStyle := csBottom;
    1:  lsscalendar.FtvCalStyle := csNone;
    2:  lsscalendar.FtvCalStyle := csRight;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LssCalendar.Date := DateOf(Now);
  YearComboBox.ItemIndex := YearComboBox.Items.IndexOf(IntToStr(LssCalendar.Year));
  MonthComboBox.ItemIndex := MonthComboBox.Items.IndexOf(IntToStr(LssCalendar.Month));
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  LssCalendar.ShowBorder := CheckBox3.Checked;
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
  LssCalendar.ShowGrid := CheckBox4.Checked;
end;

procedure TForm1.CheckBox5Click(Sender: TObject);
begin
  LssCalendar.ShowBackImage := CheckBox5.Checked;
end;

procedure TForm1.YearComboBoxChange(Sender: TObject);
begin
    LssCalendar.Year := StrToInt(YearComboBox.Text);
end;

procedure TForm1.MonthComboBoxChange(Sender: TObject);
begin
  LssCalendar.Month := StrToInt(MonthComboBox.Text);
end;

procedure TForm1.CheckBox6Click(Sender: TObject);
begin
  LssCalendar.AutoFontSize := CheckBox6.Checked;
end;

procedure TForm1.CheckBox7Click(Sender: TObject);
begin
  LssCalendar.EnWeekName := CheckBox7.Checked;
end;

procedure TForm1.CheckBox8Click(Sender: TObject);
begin
  LssCalendar.ShowArrow := CheckBox8.Checked;
end;

procedure TForm1.CheckBox9Click(Sender: TObject);
begin
  LssCalendar.ShowBackMonth := CheckBox9.Checked;
end;

procedure TForm1.CheckBox10Click(Sender: TObject);
begin
  LssCalendar.ShowHint := CheckBox10.Checked;
end;

procedure TForm1.CheckBox11Click(Sender: TObject);
begin
  LssCalendar.ShowVertical := CheckBox11.Checked;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if Trim(Edit1.Text) = '' then Exit;
  LssCalendar.HorizonScale := StrToFloat(Edit1.Text);
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  if Trim(Edit1.Text) = '' then Exit;
  LssCalendar.VerticalScale := StrToFloat(Edit2.Text);
end;

procedure TForm1.CheckBox12Click(Sender: TObject);
begin
  LssCalendar.UseISO8601 := CheckBox12.Checked;
end;

procedure TForm1.AddFtvButtonClick(Sender: TObject);
begin
  lssCalendar.FtvList.addFestival(ComboBox1.ItemIndex, Edit3.Text, Edit5.Text, ColorBox1.Selected);
  lssCalendar.Invalidate;
end;

procedure TForm1.DelFtvButtonClick(Sender: TObject);
begin
  lssCalendar.FtvList.delFestival(ComboBox1.ItemIndex, Edit3.Text);
  lssCalendar.Invalidate;
end;

procedure TForm1.AddMarkButtonClick(Sender: TObject);
begin
  lssCalendar.FtvList.addMark(ComboBox2.ItemIndex, Edit4.Text, ColorBox2.Selected);
  lssCalendar.Invalidate;
end;

procedure TForm1.DelMarkButtonClick(Sender: TObject);
begin
  lssCalendar.FtvList.delMark(ComboBox2.ItemIndex, Edit4.Text);
  lssCalendar.Invalidate;  
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
  ShellExecute(Handle,nil,Pchar('http://my.opera.com/4WAccount/'),nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.CheckBox13Click(Sender: TObject);
begin
  LssCalendar.ShadowFont := CheckBox13.Checked;
end;

end.