带24节气的月历控件

最新推荐文章于 2021-09-08 12:00:27 发布

jackie168

最新推荐文章于 2021-09-08 12:00:27 发布

阅读量2.1k

点赞数

分类专栏： Delphi控件文章标签： integer function string constructor constraints div

本文链接：https://blog.csdn.net/jackie168/article/details/277912

版权

这个博客介绍了一个自定义的月历控件，能够显示带24节气的农历日期。控件包括了农历日期转换、节气计算、干支日期等功能，并提供了详细的农历日期合法性检查和节日显示。通过TDayOfWeek、THzDate和TGzDate等记录类型，实现了农历和干支日期的计算和展示。此外，还提供了日期操作如向前向后翻月、获取农历年月日等方法。

摘要由CSDN通过智能技术生成

unit hxCalendar;

interface

uses Classes, Controls, Messages, Windows, Forms, Graphics, StdCtrls,
Grids, SysUtils,DateUtils;

type
TDayOfWeek = 0..6;
TDroppedCell = procedure(Sender: TObject; ACol, ARow: LongInt;
    var Value: string) of object;
TCellDragOver = procedure(Sender, Source: TObject; X, Y: Integer;
    State: TDragState; var Accept: Boolean) of object;
TCalendarStrings = array[0..6, 0..6] of TStringList;
    THzDate = record //农历日期
    Year: integer;
    Month: integer;
    Day: integer;
    isLeap: Boolean; //闰月
end;

TGzDate = record //干支日期
    Year: integer;
    Month: integer;
    Day: integer;
end;

ThxCalendar = class(TCustomGrid)
private
    FDate: TDate;
    FViewDate: TDate;
    //FCalColors: TLssCalColors;
    FYear: word;
    FMonth: word;
    FDay: word;
    FCalStrings: TCalendarStrings;
    FOnDroppedCell: TDroppedCell;
    FOnCellDragOver: TCellDragOver;
    FMonthOffset: Integer;
    FOnChange: TNotifyEvent;
    FReadOnly: Boolean;
    FStartOfWeek: TDayOfWeek;
    FUpdating: Boolean;
    FUseCurrentDate: Boolean;
    function GetCellText(ACol, ARow: Integer): string;
    function GetDateElement(Index: Integer): Integer;
    procedure SetCalendarDate(Value: TDate);
    procedure SetDateElement(Index: Integer; Value: Integer);
    procedure SetStartOfWeek(Value: TDayOfWeek);
    procedure SetUseCurrentDate(Value: Boolean);
    function StoreCalendarDate: Boolean;
    procedure SetCellString(ACol, ARow, ADay: Integer; Value: string); virtual;
protected
    { Protected declarations }

    procedure AcceptDropped(Sender, Source: TObject; X, Y: integer);
    procedure CellDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Change; dynamic;
    procedure ChangeMonth(Delta: Integer);
    procedure Click; override;
    function DaysPerMonth(AYear, AMonth: Integer): Integer; virtual;
    function DaysThisMonth: Integer; virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    function IsLeapYear(AYear: Integer): Boolean; virtual;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
    constructor Create(AOwner: TComponent); override;

        //返回农历 y年的总天数
    function DaysOfLunarYear(y: integer): integer;
    //返回农历 y年闰月的天数
    function daysofleapMonth(y: integer): integer;
    //返回农历 y年闰哪个月 1-12 , 没闰返回 0
    function leapMonth(y: integer): integer;
    //返回农历 y年m月的总天数
    function Daysofmonth(y, m: integer): integer;
    //算出农历, 传入公历日期, 返回农历日期
    function ToLunar(TheDate: TDate): THzDate;
    //传入 offset 返回干支, 0=甲子
    function cyclical(num: integer): string;
    //算出公历, 传入农历日期控件, 返回公历
    function ToGreg(objDate: THzDate): TDate;
    //检查农历日期是否合法
    function ChkHzDate(objDate: THzDate): Boolean;
    //某年的第n个节气为几日(从0小寒起算)
    function sTerm(y, n: integer): TDateTime;
    //求年柱，月柱，日柱(年，月为农历数字，TheDate为当天的公历日期)
    function GetGZ(y, m: integer; TheDate: TDate): TGzDate;
    //取汉字日期
    function FormatLunarDay(day:integer): string;
    //汉字月份
    function FormatLunarMonth(month:integer;isLeap:boolean): string;
    //汉字年份
    function FormatLunarYear(year:integer): string;
    // 取得指定日期的节气
    function GetJQ(TheDate: TDate): string;
      // 取得新历节日
    function GetsFtv(TheDate: TDate): string;
      // 取得农历节日
    function GetlFtv(TheDate: ThzDate): string;

property CalendarDate: TDate read FDate write SetCalendarDate stored StoreCalendarDate;

procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);

    property CellText[ACol, ARow: Integer]: string read GetCellText;
    procedure NextMonth;
    procedure NextYear;
    procedure PrevMonth;
    procedure PrevYear;
    procedure UpdateCalendar; virtual;
published
    property Align;
    property Anchors;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property Day: Integer index 3 read GetDateElement write SetDateElement stored False;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property GridLineWidth;
    property Month: Integer index 2 read GetDateElement write SetDateElement stored False;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property ShowHint;
    property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek;
    property TabOrder;
    property TabStop;
    property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True;
    property Visible;
    property Year: Integer index 1 read GetDateElement write SetDateElement stored False;
    property OnClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDock;
    property OnStartDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
end;
const
lunarInfo: array[0..200] of WORD =(
    $4bd8,$4ae0,$a570,$54d5,$d260,$d950,$5554,$56af,$9ad0,$55d2,
    $4ae0,$a5b6,$a4d0,$d250,$d295,$b54f,$d6a0,$ada2,$95b0,$4977,
    $497f,$a4b0,$b4b5,$6a50,$6d40,$ab54,$2b6f,$9570,$52f2,$4970,