?? lsscalendar.pas
字號:
sy, sm, sd: Word;
begin
DecodeDate(TheDate, sy, sm, sd);
if sy < 1900 then exit;
term:= sTerm(sy, (sm - 1) * 2); // 當月的節氣日期
//年柱 1900年立春后為庚子年(60進制36)
Result.Year:= sy - 1900 + 36;
//依立春日期調整年柱.立春日固定在公歷2月
if (sm = 1) or ((sm = 2) and (TheDate < Term)) then
Result.Year:= sy - 1900 + 35;
//月柱 農歷1900年1月小寒以前為 丙子月(60進制12)
Result.Month:= (sy - 1900) * 12 + sm + 11;
//依節氣調整月柱
if TheDate >= DateOf(term) then Result.Month:= (sy - 1900) * 12 + sm + 12;
// 1900/1/1 日柱為甲辰日(60進制10)
Result.Day:= DaysBetween(EncodeDate(1900,1,1),TheDate) + 10;
end;
// 算出公歷, 傳入農歷日期控件, 返回公歷
function TLssCalendar.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);
//本年內從大年初一過來的天數
offset:= 0;
i:= 1;
while i < m do
begin
if i = leap then
begin
if isLeap then
begin
temp:= DaysOfleapMonth(y);
isLeap:= False;
end
else begin
temp:= daysOfmonth(y, i);
isLeap:= True;
i:= i - 1;
end;
end else
temp:= daysofmonth(y, i);
offset:= offset + temp;
Inc(i);
end;
offset:= offset + objDate.Day - 1;
if (m = leap) and objDate.isLeap then //若為閏月,再加上前一個非閏月天數
offset:= offset + DaysOfMonth(y, m);
// 該年到 2000.1.1 這幾年的天數
if y > 2000 then
begin
i:= 2000;
j:= y - 1;
end
else begin
i:= y;
j:= 1999;
end;
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;
//農歷二零零零年大年初一的陽歷為 2000.2.5
Result:= incDay(EncodeDate(2000,2,5),offset);
end;
// 檢查農歷日期是否合法
function TLssCalendar.ChkHzDate(objDate: THzDate): Boolean;
begin
if (objDate.Year > 2099) or (objDate.Year < 1901)
or (objDate.Month > 12) or (objDate.Day > 30) then
begin
Result:= False;
exit;
end;
Result:= True;
if objDate.isLeap then
begin
if leapMonth(objDate.Year) = objDate.Month then
begin
if DaysOfleapMonth(objDate.Year) < objDate.Day then
Result:= False;
end else Result:= False;
end else
begin
if DaysOfMonth(objDate.Year,objDate.Month) < objDate.Day then
Result:= False;
end;
end;
// 某年的第n個節氣為幾日(從0小寒起算)
function TLssCalendar.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(EncodeDateTime(1900,1,6,2,5,0,0),i);
Result:= temp;
end;
//傳入干支y年,返回生肖
function TLssCalendar.GetAnimal(y: integer): string;
begin
Result := Animals[y mod 12];
end;
// 傳入 offset 返回干支, 0=甲子
function TLssCalendar.cyclical(num: integer): string;
begin
Result:= Gan[num mod 10] + Zhi[num mod 12];
end;
function TLssCalendar.FormatLunarDay(day:integer): string;
begin
case day of
1..10: Result:= nStr2[0] + nStr1[day];
11..19: Result:= nStr2[1] + nStr1[day - 10];
20: Result:= nStr1[2] + nStr1[10];
21..29: Result:= nStr2[2] + nStr1[day - 20];
30: Result:= nStr1[3] + nStr1[10];
else Result :='';
end;
end;
function TLssCalendar.FormatLunarMonth(month:integer;isLeap:boolean): string;
begin
case month of
1: Result:= '正';
2..10: Result:= nStr1[month];
11: Result:= nStr1[10] + nStr1[month - 10]; //Result:= '冬';
12: Result:= '臘';
//11..12: Result:= nStr1[10] + nStr1[month - 10];
else result :='';
end;
if isLeap then Result:= '閏' + Result;
Result:= Result + '月';
end;
function TLssCalendar.FormatLunarYear(year:integer): string;
var
temp: integer;
zero: string;
begin
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;
end
else
Result:= Result + zero;
if year >= 10 then
begin
temp:= year div 10;
Result:= Result + nStr1[temp];
year:= year - temp * 10;
end
else
Result:= Result + zero;
if year = 0 then Result:= Result + zero else
Result:= Result + nStr1[year];
Result:= Result + '年';
end;
//漢字星期幾
function TLssCalendar.FormatWeekDay(WeekDay:integer): string;
begin
Result := '星期' + nStr1[WeekDay mod 7];
end;
// 取得指定日期的節氣
function TLssCalendar.GetJQ(TheDate: TDate): string;
var
jq: Integer;
term: TDateTime;
begin
Result:= '';
jq:= (MonthOf(TheDate) - 1) * 2;
term:= sTerm(Yearof(TheDate), jq); //節氣時間
if DateOf(term) = TheDate then Result:= solarTerm[jq]
else
begin
term:= sTerm(Yearof(TheDate), jq + 1); //中氣時間
if DateOf(term) = TheDate then Result:= solarTerm[jq+1];
end;
end;
//取得當日的節日
function TLssCalendar.GetFtv(TheDate: TDate): string;
var
TempColor: TColor;
begin
Result := GetFtv(TheDate, TempColor);
end;
//取得當日的節日
function TLssCalendar.GetFtv(TheDate: TDate; var fcolor: TColor): string;
var
HzDate, HzDate2: THzDate;
TempColor: TColor;
TempStr: string;
begin
Result := '';
TempStr := '';
fcolor := -1;
HzDate := ToLunar(TheDate);
HzDate2 := ToLunar(TheDate + 1);
if HzDate.Month <> HzDate2.Month then //針對"0100"除夕
begin
HzDate2.Day := 0;
TempStr := FFtvList.GetLunarFtv(HzDate2, TempColor);
end;
if TempStr <> '' then
begin
fcolor := TempColor;
Result := TempStr;
end;
TempStr := FFtvList.GetLunarFtv(HzDate, TempColor);
if (TempStr <> '') then
begin
if fcolor = -1 then fcolor := TempColor;
Result := Trim(Result + ' ' + TempStr);
end;
TempStr := FFtvList.GetSolarFtv(TheDate, TempColor);
if (TempStr <> '') then
begin
if fcolor = -1 then fcolor := TempColor;
Result := Trim(Result + ' ' + TempStr);
end;
TempStr := FFtvList.GetWeekFtv(TheDate, TempColor);
if (TempStr <> '') then
begin
if fcolor = -1 then fcolor := TempColor;
Result := Trim(Result + ' ' + TempStr);
end;
end;
//取得當日的標記
function TLssCalendar.GetMark(TheDate: TDate): TColor;
var
HzDate: THzDate;
begin
HzDate := ToLunar(TheDate);
Result := FFtvList.GetLunarMark(HzDate);
if Result > -1 then Exit;
Result := FFtvList.GetSolarMark(TheDate);
if Result > -1 then Exit;
Result := FFtvList.GetWeekMark(TheDate);
end;
{
//存儲星座配信息
1白羊座: 03月21日-------04月19日 Aries
2金牛座: 04月20日-------05月20日 Taurus
3雙子座: 05月21日-------06月21日 Gemini
4巨蟹座: 06月22日-------07月22日 Cancer
5獅子座: 07月23日-------08月22日 Leo
6處女座: 08月23日-------09月22日 Virgo
7天秤座: 09月23日-------10月23日 Libra
8天蝎座: 10月24日-------11月21日 Scorpio
9射手座: 11月22日-------12月21日 Sagittarius
10摩羯座: 12月22日-------01月19日 Capricorn
11水瓶座: 01月20日-------02月18日 Aquarius
12雙魚座: 02月19日-------03月20日 Pisces
}
//根據公歷日期,返回星座
Function TLssCalendar.Constellation(TheDate: TDate): String;
var
y, m, d: Word;
Begin
DecodeDate(TheDate, y, m, d);
Case m Of
1:
Begin
If d < 20 Then result := '摩羯座';
If d >= 20 Then result := '水瓶座';
End;
2:
Begin
If d < 19 Then result := '水瓶座';
If d >= 19 Then result := '雙魚座';
End;
3:
Begin
If d < 21 Then result := '雙魚座';
If d >= 21 Then result := '白羊座';
End;
4:
Begin
If d < 20 Then result := '白羊座';
If d >= 20 Then result := '金牛座';
End;
5:
Begin
If d < 21 Then result := '金牛座';
If d >= 21 Then result := '雙子座';
End;
6:
Begin
If d < 22 Then result := '雙子座';
If d >= 22 Then result := '巨蟹座';
End;
7:
Begin
If d < 23 Then result := '巨蟹座';
If d >= 23 Then result := '獅子座';
End;
8:
Begin
If d < 23 Then result := '獅子座';
If d >= 23 Then result := '處女座';
End;
9:
Begin
If d < 23 Then result := '處女座';
If d >= 23 Then result := '天秤座';
End;
10:
Begin
If d < 24 Then result := '天秤座';
If d >= 24 Then result := '天蝎座';
End;
11:
Begin
If d < 22 Then result := '天蝎座';
If d >= 22 Then result := '射手座';
End;
12:
Begin
If d < 22 Then result := '射手座';
If d >= 22 Then result := '摩羯座';
End;
End;
End;
//返回當日所在周數
function TLssCalendar.WeekOfYear(TheDate: TDate): integer;
var
TempDate: TDate;
begin
Result := WeekOfTheYear(TheDate); //ISO8601 standard compliant
if FUseISO8601 then Exit;
//由于WeekOfTheYear() 使用ISO 8601標準,每周為星期一到星期天.
//現根據日歷顯示,調整為從星期天到星期六為一周
if (Result > 50) and (MonthOf(TheDate) = 1) then
begin
Result := 1;
if (DayOfTheWeek(TheDate) = 7) and (FormatDateTime('mm-dd',TheDate) <> '01-01') then
inc(Result);
exit;
end;
TempDate := EncodeDate(YearOf(TheDate), 1, 1);
if (WeekOfTheYear(TempDate) > 50) and (DayOf
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -