Monthly calendar control with 24-kind
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; trzdate = record // Lunar Date Year: Integer; Month: Integer; day: integer; isleap: boolean; // Leap month end;
TGZDATE = Record // Dedicated Date Year: Integer; Month: Integer; DAY: Integer;
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;
// Return the total days of the Lunar Yenda Function DaySoflunaryEar (Y: Integer): Integer; // Return Lunu Yenda Lunu Function DaySofleapmonth (Y: Integer): Integer; // Return to the Lunar Calendar Yence 1 month 1-12 No ottery returning 0 function leapmonth (Y: integer): integer; // Returns the total number of days of the Yenda M-month Function DaySofmonth (Y, M: Integer): integer; // Calculate the lunar calendar, return to the Queen Date, return to the lunar calendar Date Function Tolunar (TDATE: TDATE): THZDATE; / / Passing to Offset Returns Dry Dried Dry, 0 = Methon Function Cyclical (Num: Integer): String; // Calculating the Queen, Passing the Lunar Date Control, Returning the Queu Function Togreg (Objdate: Thzdate; // Check if the lunar dates are legal Function Chkhzdate (Objdate: twzdate): boolean; // Ninth Nights for a few days (from 0 small cold) Function STERM (Y, N: Integer): TDATETIME; // Survey the column, the moon post, Japanese column (year, month for the lunar calendar) Function GETGZ (Y, M: Integer; theDate: tdate): tgzdate; // Take the Chinese character FUNCTION FormatLunarDay (day: integer): string; // Character month function FormatLunarMonth (month: integer; isLeap: boolean): string; // Year Chinese characters function FormatLunarYear (year: integer): string; // get the throttle function GetJQ specified date (TheDate: tdate): String; // Get the new calendar Function GetSftv (TDATE: TDATE): String; // Get the Lunar Festival Function Getlf (THzdate): String; Property Calendardate: Tdate Read Fdate Write SetCalendate Stored Storecalendate;
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: Boole an 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, $ 9AD0, $ 55D2, $ 4AE0, $ A5B6, $ A4D0, $ D250, $ D295, $ B54F, $ D6A0 , $ 4977, $ 497F, $ A4B0, $ B4B5, $ 6A50, $ 6D40, $ 52F2, $ 4970, $ 6566, $ 6A0, $ EA50, $ 6A95, $ 5ADF $ 2B60, $ 86E3, $ C95F, $ D4A0, $ D8A6, $ B55F, $ 56A0, $ A5B4, $ 25DF, $ 92D0, $ D2B2, $ A950, $ B557, $ 6CA0, $ 6CA0, $ 6 B550, $ 5355, $ 4DAF, $ A5B0, $ 4573, $ 6AA0, $ AEA6, $ AB50, $ 4B60, $ AAE4, $ A570, $ 5260, $ F263, $ D950, $ 5B57, $ 56A0, $ 4AD0, $ 4D0, $ D4D4, $ D250, $ D558, $ B540, $ 5BF, $ 49B0, $ A974, $ A4B0, $ B27A, $ 6A50 $ 6d40, $ AF46, $ 4AF5, $ 4970, $ 64B0, $ 74A3, $ 5A50, $ 6B58, $ 5AC0, $ 92E0, / / 1999 $ C960, $ D954, $ D4A0, $ DA50, $ 25D0, $ 92D0, $ CAB5, $ A950, $ B4A0, $ BAA4, $ AD50, $ 55D9, $ 4BA0, $ A5B0, $ 5176, $ 52BF, $ 52BF, $ A930, $ 7954, $ 5B52, $ 4B60, $ A6E6, $ A4E0, $ D260, $ EA65, $ D530, $ 5AA0, $ 46A3, $ 96D0, $ 4AFB, $ 4AD0, $ A4D0, $ D0B6, $ D25F, $ D520, $ DD45, $ B5A0, $ 56D0, $ 55B2, $ 49B0, $ A577, $ A4B0, $ AA50, $ 1 $ 4B63, $ 937F, $ 49F8, $ 4970, $ 64B $ 68a6, $ EA5F, $ 6B20, $ 92E0, $ D2E3, $ C960, $ D557, $ D4A0, $ DA50, $ 5D55, $ 56A0, $ A6D0, $ 55D4, $ 52D0, $ A9B8, $ A950, $ B4A0, $ 55A6, $ ABA4, $ A5B0, $ 52B0, $ B273, $ 6930, $ 7337, $ 6A0, $ AD50, $ 4B55, $ 4B6F, $ A570, $ 54 E4, $ D260, $ 2AA6, $ 56DF, $ 4AE0, $ A9D4, $ A4D0, $ D150, $ F252, $ D520); GAN: Array [0..9] of string [2] = ('A', 'B ",' C ',' Ding ',' Hydroe ',' Herself ',' Geng ',' Xin ',' 壬 ',' ');
Zhi: array [0..11] of string [2] = ('son', 'ugly', '寅', '', '', '巳', '午', 'unsained', ' ',' 酉 ',' ',' Hai ');
Animals: array [0..11] of string [2] = ('rat', 'cattle', 'tiger', 'rabbit', 'dragon', 'snake', 'horse', 'sheep', 'monkey ',' Chicken ',' dog ',' pig '); Solarterm: array [0..23] of string [4] = (' Xiaoyan, 'big cold ",' 立 春 ',' rainwater ',' horror ' , 'Spring Point', 'Qingming', 'Valley,' Lixia ',' Xiaoyu ',' Mang, 'Summer Sepae,' Xiaoxia ',' Summer ',' Liqiu ',' Bai Summer ',' Bai Lu ',' Autumn points ',' cold deu ',' frostn ',' all winter ',' Snow ',' Snow ',' Winter Solo
sTermInfo: Array [0..23] of integer = (0,21208,42467,63836,85337,107014,128867,150921, 173149,195551,218072,240693,263343,285989,308563,331033, 353350,375494,397447 , 419210, 440795, 462224, 483532, 504758;
NSTR1: ARRAY [0..10] of string [2] = ('Japan,' one ',' 2 ',' three ',' four ',' five ',' six ',' seven ", 'eight ','ninety');
NSTR2: Array [0..3] of string [2] = ('beginning', 'ten', '廿', '卅'); sftv: array [0..22] of string = ('0101 * New Year's Day ',' 0214 Valentine's Day, '0308 Women's Day', '0315 Consumer Rights Day,' 0401 April Fool's Day ',' 0501 Labor Day ',' 0504 Youth Festival ',' 0512 Nurse Festival ',' 0601 Children's Day ',' 0701 Jianzheng Festival Hong Kong Return Memorial ',' 0801 Jianjun Festival ',' 0808 Father's Day ',' 0909 Mao Zedong Due to Memorial ',' 0910 Teacher's Day ',' 0928 Confucius ',' 1001 * National Day, '1024 United Nations Day', '1024 Sun Yat-sen', '1112 Sun Yat-sen's Birthday', '1220 Macau Return Memorial', '1225 Christmas Day', '1226 Mao Zedong Birth "); LFTV: array [ 0..9] OF STRING = ('0101 * Spring Festival', '0115 Lantern Festival', '0505 Dragon Boat Festival', '0707 Tanabata Valentine's Day', '0715 Middle Festival', '0815 Mid-Autumn Festival', '0909 Chongyang Quest ',' 1208 Laba Festival ',' 1224 Laba ',' 0100 * New Year's Eve '); Procedure Register; Implementation // Uses DS1, U7; Procedure Register; Begin RegisterComponents (' Samples', [THXCALENDAR]); END;
constructor ThxCalendar.Create (AOwner: TComponent); begin inherited Create (AOwner); {defaults} FUseCurrentDate: = True; FixedCols: = 0; FixedRows: = 1; ColCount: = 7; RowCount: = 7; ScrollBars: = ssNone; Options: = Options - [Gorangeselect] [godrawfocusselected]; fdate: = DATE; UpdateCalendar;
procedure ThxCalendar.Change; begin if Assigned (FOnChange) then FOnChange (Self); end; procedure ThxCalendar.MouseToCell (X, Y: Integer; var ACol, ARow: Longint); var Coord: TGridCoord; begin Coord: = MouseCoord (X , Y); acol: = Coord.x;.
{AcceptDropped override} procedure ThxCalendar.AcceptDropped (Sender, Source: TObject; X, Y: integer); var ACol, ARow: LongInt; Value: string; begin {convert X and Y to Col and Row for convenience} MouseToCell (X, Y, acol, zpond} {let usr respond ● {ion, acol, arow, value; {if user returns a string add it to the cells list} if value <> ' THEN SETCELLSTRING (ACOL, AROW, 0, VALUE); {set focus to hxcalendar} setfocus; {force redraw} invalidate;
{CellDragOver override} procedure ThxCalendar.CellDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var ACol, ARow: LongInt; begin {convert X and Y to Col and Row for convenience } MouseToCell (X, Y, ACol, aRow); {allow user to set Accept the way they want} if Assigned (FOnCellDragOver) then FOnCellDragOver (Sender, Source, ACol, aRow, State, Accept); {if Accept = true then apply further logic else leave Accept = false} if Accept = true then if (not FUpdating) and (not FReadOnly) and (CellText [ACol, aRow] <> '') then Accept: = true else Accept: = false; end; {. SetCellString - adds a string to the cells stringlist based on Col or Row or Day of month} procedure ThxCalendar.SetCellString (ACol, aRow, ADay: Integer; Value: string); var i, j: integer; TheCellText: string; Begin if (not fupdating) and (NOTFREADONLY) AND (CellText [Acol, Arow] <") THEN BEGIN {if aday is being used Calc Acol and anly. Doesn't Matter if Acol and anly <> 0 we just coalc itm anyway} if aday <> 0 Then Begin for i: = 0 to 6 do for j: = 1 to 6 do begin thecelltext: = CellText [i, j]; if (thecelltext <> ') and (aday = strellText) The begin acol: = i; process: = j; end; end; end; {if no stringlist assigned the crete one} if fcalstrings [acol, arow] = nil THEN FCALSTRINGS [ACOL, AROW]: = TStringList.create; {add the line of text} fcalstrings [acol, zs] .add (value); end;
procedure ThxCalendar.Click; var TheCellText: string; begin inherited Click; TheCellText: = CellText [Col, Row]; if TheCellText <> '' then Day: = StrToInt (TheCellText); end; function ThxCalendar.IsLeapYear (AYear: Integer) : Boolean; Begin Result: = (Ayear Mod 4 = 0) AND (Ayear Mod 100 <> 0) or (Ayear Mod 400 = 0);
Function thxcalendar.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;
Function thxcalendar.daysthismonth: integer; begin result: = dayspermonth (year, month);
{Procedure ThxCalendar.DrawCell (ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var TheText: string; begin TheText: = CellText [ACol, ARow]; with ARect, Canvas do TextRect (ARect, Left (Right - Left - TextWidth (theText)) div 2, Top (Bottom - Top - TextHeight (theText)) div 2, theText); end;} procedure ThxCalendar.DrawCell (ACol, aRow: Longint; aRect: TRect; aState: TGridDrawState ); Var hzdate: thzdate; Thet, Ry, DZ, Hzdaystr, sf: string; mydate: tdate
Begin Thet: = Celltext [Acol, Arow]; // decodedate (fdate, ayear, amonth, aday); if (Thet <> ') and (Arow <> 0) THEN BEGIN
MyDate: = encodedate (Year, Month); hzdate: = tolunar (MyDate); dz: = getjq (mydate); if dz = '' Then if hzdate.day = 1 Then Ry: = Formatlunarmonth (Hzdate .Month, hzdate.isleap) Else = formatlunarday (hzdate.day); if getsftv (mydate) <> '' Then sf: = getsftv (mydate); if getlf (hzdate) <> '' Then sf: = sf GetLFTV (hzdate); end else mydate: = 0; with all, canvas do begin if dz <> 'TENBEGIN FONT.COLOR: = $ 000000FF; TextRect (all, left 2, top 2, Thet sf ); Textout (all, all, all sf <> '' Then Begin if s> '' Then Begin font.color: = $ 000000FF; TextRect (all, left 2, TOP 2, THETEXT SF); Else Begin Font.color: = CLBLUE; TextRect (all ip 2, TOP 2, THETEXT SF); end; font.color: = CLBLUE; TextOut Font.size 10, all, all 25, RY);
End; end;
function ThxCalendar.GetCellText (ACol, ARow: Integer): string; var DayNum: Integer; begin if ARow = 0 then {day names at tops of columns} Result: = ShortDayNames [(StartOfWeek ACol) mod 7 1] else begin Daynum: = fmonthoffset Acol (Arow - 1) * 7; if (Daynum <1) or (Daynum> Daysthismonth) Then Result: = 'Else Result: = INTOSTR (DAYNUM); END;
function ThxCalendar.SelectCell (ACol, ARow: Longint): Boolean; begin if ((not FUpdating) and FReadOnly) or (CellText [ACol, ARow] = '') then Result: = False else Result: = inherited SelectCell (ACol, Arow); end; procedure thxcalendar.Setcalendardate (value: tdate); begin fdate: = value; UpdateCalendar;
Function thxcalendar.Storecalendardate: boolean; begin result: = not fusecurrentdate;
Function thxcalendar.getdateElement (INDEX: Integer): Integer; Var Ayear, Amonth, Aday: Word; Begin Decodedate (Fdate, Ayear, Amonth, Aday); Case Index of 1: Result: = Ayear; 2: Result: = AMONTH; 3: result: = aday; Else Result: = -1; end;
Procedure thxcalendar.SetdateElement (index: integer; value: integer); var Ayear, Amonth, Aday: word; begin if value> 0 Then Begin decodate (fdate, ayear, amonth, aday); Case Index of 1: if ayear <> Value kilone: = value else exit; 2: if (value <= 12) and (value <> amonth) THEN AMONTH: = Value else exit; 3: if (value <= daysthismonth) and (value <> aday) THEN Aday: = value else ixit; else exit; end; fdate: = encodedate (Ayear, Amonth, aday); fusecurrentdate: = false; UpdateCalendar; Change; end;
Procedure thxcalendar.setstartofweek; begin if value <> fstartofwek dam fstartofwek: = value; Updatecalendar; end;
procedure ThxCalendar.SetUseCurrentDate (Value: Boolean); begin if Value <> FUseCurrentDate then begin FUseCurrentDate: = Value; if Value then begin FDate: = Date; {use the current date, then} UpdateCalendar; end; end; end;
{Given a value of 1 or -1, moves to Next or Prev month accordingly} procedure ThxCalendar.ChangeMonth (Delta: Integer); var AYear, AMonth, ADay: Word; NewDate: TDate; CurDay: Integer; begin DecodeDate (FDate, Ayear, Amonth, Aday; Curday: = aday; if delta> 0 Then aday: = dayspermonth (Ayear, amonth) else aday: = 1; newdate: = encodedate (Ayear, Amonth, aday); newdate: = newdate delta ; DecodeDate (NewDate, AYear, AMonth, ADay); if DaysPerMonth (AYear, AMonth)> CurDay then ADay: = CurDay else ADay: = DaysPerMonth (AYear, AMonth); CalendarDate: = EncodeDate (AYear, AMonth, ADay); end Procedure thxcalendar.prevmonth; begin changemonth (-1);
Procedure thxcalendar.nextmonth; begin changeMonth (1);
Procedure thxcalendar.nexTyear; begin if isleear (year) and (month = 2) and (day = 29) Then day: = 28; year: = year 1;
Procedure thxcalendar.prevyear; begin if isleear (year) and (month = 2) and (day = 29) Then day: = 28; Year: = year - 1;
procedure ThxCalendar.UpdateCalendar; var AYear, AMonth, ADay: Word; FirstDate: TDate; begin FUpdating: = True; try DecodeDate (FDate, AYear, AMonth, ADay); FirstDate: = EncodeDate (AYear, AMonth, 1); FMonthOffset: = 2 - (DAYOFWEEK (FirstDate) - Startofweek 7) MOD 7); {day of week for 1st of Month} if fmonthoffset = 2 THEN FMONTHOFSET: = -5; MoveColrow ((Aday - fmonthoffset) MOD 7, (Aday " - FMONTHOFFSET) DIV 7 1, False, False; Invalidate; Finally fuPDating: = false; end;
procedure ThxCalendar.WMSize (var Message: TWMSize); var GridLines: Integer; begin GridLines: = 6 * GridLineWidth; DefaultColWidth: = (Message.Width - GridLines) div 7; DefaultRowHeight: = (Message.Height - GridLines) div 7; End; function thxcalendar.daysoflunaryear (Y: integer): Integer; var i, sum: integer; begin sum: = 348; // 29 * 12 i: = $ 8000; while i> $ 8 do begin if (lunarinfo [y - 1900 ] and i)> 0 THEN SUM: = SUM 1; I: = I shr 1; end; result: = sum daysofleapmonth (y); end; // Return to Lunu Calenda Yending Month Function Thxcalendar.daysofleapMonth (Y : Integer: INTEGER; Begin if Leapmonth (Y)> 0 Then IF (LunarInfo [Y - 1899] and $ f) = $ f) = $ f Then Result: = 30 else result: = 29 else result: = 0;
// Return to the lunar calendar Y, 1st of 1-12, there is no 闰 to return to 0Function thxcalendar.leapmonth (Y: integer): Integer; var lm: word; begin lm: = lunarinfo [y - 1900] and $ f; if lm = $ f Then Result: = 0 else result: = lm; end;
// Return to the Lunar Yend Month Number Function Thxcalendar.daysofmonth (Y, M: Integer): Integer; Var Temp1, Temp2, Temp3: Word; Begin Temp1: = LunarInfo [Y - 1900]; TEMP2: = $ 8000; IF m> 1 TEMP2: = $ 8000 SHR (M - 1); Temp3: = Temp1 and Temp2; if Temp3> 0 THEN Result: = 30 else result: = 29;
/ / Calculate the lunar calendar, return to the date of the birth, return Lunu Date Function THXCALENDAR.TOLunar (THEDATE: TDATE): thzdate; var theyear, Themonth, Leap, Temp, Offset: Integer; Begin IF (32> these) or (thisDate> = 73416) THEN / / 73415 = Encodedate (2100, 12, 31) Begin // 32 = Encodedate (1900, 1,31) Lunar calendar January 1 Result.Year: = 0; Result.Month: = 0; Result .Day: = 0; Result.isleap: = false; exit; end; offset: = daysbetween (32, thedeear: = 1900; while offset> 0 do beg, temp: = daysoflunaryear; theyear: = theyear 1; Offset: = Offset - Temp; End; IF Offset <0 THEN BEGIN OFFSET: = Offset Temp; Theyear: = TheYear - 1; End; Leap: = LeapMonth (theyear); // Which month Result.isleap : = False; themonth: = 0; while offset> = 0 do begin themonth: = THEMONTH 1; TEMP: = daysofmonth (theyear, themonth); offset: = offset - Temp; // minus the number of days of the day (Offset) > = 0) And (themonth = leap) Then // If there is still the remaining days, it is Begin // this month, minus the moonlight Number; Temp: = daySofleapmonth; Offset: = Offset - Temp; if Offset <0 Then Result.isleap: = true; // Rating the month of the moon sign is true; end; end; if Offset <0 Then Begin Offset: = Offset Temp; End; Result.Year: = theyear; Result.Month: = THEMONTH; Result.day := Offset 1;
// Survey the column, moon post, Japanese post // year, month, month for the lunar calendar, objdate's repayment date Function Thxcalendar.GETGZ (Y, M: Integer; theDate: tdate): tgzdate; var Term: Tdate; Sy , SM, SD: Word; Begin Decodedate (THEDATE, SY, SM, SD); Term: = STERM (SY, SY, (SM - 1) * 2); // The holiday date
// Years of the year after the spring of the spring (60 credits 36) Result.Year: = SY - 1900 36; // Only the Spring Date Adjustment Year Pillar. Li Sunday fixed in the gift calendar IF (SM = 2 ) and (theDATE
// 1900/1/1 The post is Acheng Day (60) Result.day := Daysbetween (EncodeDate (1900, 1, 1), theDate 10;
// Call the question, return to the Lunar Date Control, return to the public caucas Function Thxcalendar.togreg (Objdate: thzdate): TDATE; VAR I, J, T, LEAP, TEMP, OFFSET: Integer; isleap: boolean; y, m: integer; Begin
Result: = Encodedate (1, 1, 1); if NOT Chkhzdate (Objdate) THEN EXIT
ISLEAP: = false; y: = objdate.year; m: = objdate.month; leap: = leapmonth (y);
// The number of days from the beginning of the New Year is Offset: = 0; I: = 1; While i OFFSET: = Offset objdate.day - 1; if (m = leap) and objdate.isleap dam // If you are a month, plus the previous non-leap monthly day of the number of offset: = offset daysofmonth (y, m); // This year to 2000.1.1 The number of days in these years IF Y> 2000 THEN BEGIN I: = 2000; J: = Y - 1; ELSE BEGIN I: = Y; J: = 1999; Temp: = 0; for t: = i to j do begin Temp: = Temp Daysoflunaryear (t); end; IF Y> 1999 Then Offset: = Offset Temp else Offset: = Offset - Temp; // Lunar calendar 2000.2.5 Result: = incday (EncodeDate (2000, 2, 5), offset; end; // Check if the lunar dates are legal function trxcalendar.chkhzdate (Objdate : Twzdate; boolean; begin if (objdate.year> 2099) or (objdate.Month> 12) or (objdate.day> 30) The begin result: = false; EXIT; Result: = True; if objDate.isLeap then begin if leapMonth (objDate.Year) = objDate.Month then begin if DaysOfleapMonth (objDate.Year) // Ninth nation of the year (from 0 small cold) Function thxcalendar.sterm (Y, N: integer): tdatetime; var temp: tdatetime; t: real; i: int64; begin T: = Sterminfo [N]; T: = T * 60000; T: = T 31556925974.7 * (Y - 1900); i: = round (t); Temp: = IncmilliseCond (ENCODITETIME (1900, 1, 6, 2, 5, 0 , 0), I); Result: = TEMP; END; // Pass to Offset Return to Dry, 0 = 号 Function Thxcalendar.CyClical (Num: Integer): String; Begin Result: = GaN [Num MOD 10] ZHI [Num MOD 12] '(' Animals [Num MOD 12 ] 'Year)'; end; Function thxcalendar.formatlunarday (day: integer): string; begin case day of 1..10: result: = nStr2 [0] nStr1 [day]; 11..19: Result: = nStr2 [1] nSTR1 [day - 10: Result: = NSTR1 [2] NSTR1 [10]; 21..29: Result: = NSTR2 [2] NSTR1 [day - 20]; 30: Result: = nStr1 [3] NSTR1 [10]; Else Result: = '; end; end; Function thxcalendar.formatlunarmonth (Month: boolean): string; begin case: = nstr1 [month]; 11..12: result: = nSTR1 [10] nStr1 [Month - 10]; Else Result: = '; End; if isleap the result: =' ' result; result: = result ' month '; end; function thxcalendar.formatlunaryear (year: integer): String; var temp: ion; begin zero: = 'zero'; Temp: = year div 1000; result: = nStr1 [TEMP]; year: = year - temp * 1000; If Year> = 100 Then Begin Temp: = Year Div 100; Result: = Result NSTR1 [TEMP]; Year: = YEAR - TEMP * 100; Else Result: = Result ZERO; If Year> = 10 Then Begin Temp: = Year Div 10; Result: = Result NSTR1 [TEMP]; Year: = YEAR - TEMP * 10; Else Result: = Result ZERO; If Year = 0 Then Result: = Result ZERO Else Result: = Result NSTR1 [Year]; Result: = Result '; end;
