unit Lunar;interface
uses SysUtils;//國曆轉農曆(民國年, 月, 日, var 農曆年, 農曆月, 農曆日)
procedure Solar2Lunar(SYear, SMonth, SDay : Integer; Var LYear, LMonth, LDay : Integer);
//農曆轉國曆(農曆年, 農曆月, 農曆日, var 民國年, 月, 日)
procedure Lunar2Solar(LYear, LMonth, LDay : Integer; Var SYear, SMonth, SDay : Integer);
//輸入農曆年份換算六十甲子名稱
function YearName(LYear : integer) : string;
//得知農曆之月份天數
function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;implementation
const
SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸');
c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥');// Magic String :
LongLife : array[1..111] of string[9] = (
'132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6
'132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12
'131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18
'061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24
'032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30
'132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36
'132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42
'132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48
'062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54
'033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60
'131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66
'132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72
'102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78
'051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84
'131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90
'133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96
'132349037', '053243125', '132709044', '132890033', '042986122', '132901040', //102
'091373130', '131210049', '132651038', '061303127', '131323046', '132707035', //108
'041941124', '131706042', '132773031'); //111var
LMDay : array[1..13] of integer;
InterMonth, InterMonthDays, SLRangeDay : integer;
function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;function YearName(LYear : integer) : string;
var
x, y, ya : integer;
begin
ya := LYear;
if ya < 1 then
ya := ya + 1;
if ya < 12 then
ya := ya + 60;
x := (ya + 8 - ((ya + 7) div 10) * 10);
y := (ya - ((ya-1) div 12) * 12);
result := c1[x]+c2[y];
end;procedure CovertLunarMonth(magicno : integer);
var
i, size, m : integer;
begin
m := magicno;
for i := 12 downto 1 do begin
size := m mod 2;
if size = 0 then
LMDay[i] := 29
else
LMDay[i] := 30;
m := m div 2;
end;
end;procedure ProcessMagicStr(yy : integer);
var
magicstr : string;
dsize, LunarMonth : integer;
begin
magicstr := LongLife[yy];
InterMonth := StrToInt(Copy(magicstr, 1, 2));
LunarMonth := StrToInt(copy(magicstr, 3, 4));
CovertLunarMonth(LunarMonth);
dsize := StrToInt(Copy(magicstr, 7, 1));
case dsize of
0 : InterMonthDays := 0;
1 : InterMonthDays := 29;
2 : InterMonthDays := 30;
end;
SLRangeDay := StrToInt(Copy(Magicstr, 8, 2));
end;function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;
begin
ProcessMagicStr(LYear);
if LMonth < 0 then
Result := InterMonthDays
else
Result := LMDay[LMonth];
end;procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer);
var
i, day : integer;
begin
day := 0;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
ProcessMagicStr(SYear);
if SMonth = 1 then
day := SDay
else begin
for i := 1 to SMonth-1 do
day := day + SMDay[i];
day := day + SDay;
end;
if day <= SLRangeDay then begin
day := day - SLRangeDay;
processmagicstr(SYear-1);
for i := 12 downto 1 do begin
day := day + LMDay[i];
if day > 0 then
break;
end;
LYear := SYear - 1;
LMonth := i;
LDay := day;
end else begin
day := day - SLRangeDay;
for i := 1 to InterMonth-1 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if day <= 0 then begin
LYear := SYear;
LMonth := i;
LDay := day + LMDay[i];
end else begin
day := day - LMDay[InterMonth];
if day <= 0 then begin
LYear := SYear;
LMonth := InterMonth;
LDay := day + LMDay[InterMonth];
end else begin
LMDay[InterMonth] := InterMonthDays;
for i := InterMonth to 12 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if i = InterMonth then
LMonth := 0 - InterMonth
else
LMonth := i;
LYear := SYear;
LDay := day + LMDay[i];
end;
end;
end;
end;procedure Lunar2Solar(LYear, LMonth, LDay : integer; var SYear, SMonth, SDay : integer);
var
i, day : integer;
begin
day := 0;
SYear := LYear;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
processmagicstr(SYear);
if LMonth < 0 then
day := LMDay[InterMonth];
if LMonth <> 1 then
for i := 1 to LMonth-1 do
day := day + LMDay[i];
day := day + LDay + SLRangeDay;
if (InterMonth <> 13) and (InterMonth < LMonth) then
day := day + InterMonthDays;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
if day > 0 then begin
SYear := SYear + 1;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
end;
//i := i - 1;
day := day + SMDay[i];
//if i = 0 then begin
// i := 12;
// SYear := SYear - 1;
// day := day + 31;
//end;// else
//day := day + SMDay[i];
SMonth := i;
SDay := day;
end;end.
uses SysUtils;//國曆轉農曆(民國年, 月, 日, var 農曆年, 農曆月, 農曆日)
procedure Solar2Lunar(SYear, SMonth, SDay : Integer; Var LYear, LMonth, LDay : Integer);
//農曆轉國曆(農曆年, 農曆月, 農曆日, var 民國年, 月, 日)
procedure Lunar2Solar(LYear, LMonth, LDay : Integer; Var SYear, SMonth, SDay : Integer);
//輸入農曆年份換算六十甲子名稱
function YearName(LYear : integer) : string;
//得知農曆之月份天數
function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;implementation
const
SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸');
c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥');// Magic String :
LongLife : array[1..111] of string[9] = (
'132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6
'132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12
'131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18
'061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24
'032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30
'132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36
'132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42
'132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48
'062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54
'033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60
'131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66
'132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72
'102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78
'051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84
'131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90
'133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96
'132349037', '053243125', '132709044', '132890033', '042986122', '132901040', //102
'091373130', '131210049', '132651038', '061303127', '131323046', '132707035', //108
'041941124', '131706042', '132773031'); //111var
LMDay : array[1..13] of integer;
InterMonth, InterMonthDays, SLRangeDay : integer;
function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;function YearName(LYear : integer) : string;
var
x, y, ya : integer;
begin
ya := LYear;
if ya < 1 then
ya := ya + 1;
if ya < 12 then
ya := ya + 60;
x := (ya + 8 - ((ya + 7) div 10) * 10);
y := (ya - ((ya-1) div 12) * 12);
result := c1[x]+c2[y];
end;procedure CovertLunarMonth(magicno : integer);
var
i, size, m : integer;
begin
m := magicno;
for i := 12 downto 1 do begin
size := m mod 2;
if size = 0 then
LMDay[i] := 29
else
LMDay[i] := 30;
m := m div 2;
end;
end;procedure ProcessMagicStr(yy : integer);
var
magicstr : string;
dsize, LunarMonth : integer;
begin
magicstr := LongLife[yy];
InterMonth := StrToInt(Copy(magicstr, 1, 2));
LunarMonth := StrToInt(copy(magicstr, 3, 4));
CovertLunarMonth(LunarMonth);
dsize := StrToInt(Copy(magicstr, 7, 1));
case dsize of
0 : InterMonthDays := 0;
1 : InterMonthDays := 29;
2 : InterMonthDays := 30;
end;
SLRangeDay := StrToInt(Copy(Magicstr, 8, 2));
end;function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;
begin
ProcessMagicStr(LYear);
if LMonth < 0 then
Result := InterMonthDays
else
Result := LMDay[LMonth];
end;procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer);
var
i, day : integer;
begin
day := 0;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
ProcessMagicStr(SYear);
if SMonth = 1 then
day := SDay
else begin
for i := 1 to SMonth-1 do
day := day + SMDay[i];
day := day + SDay;
end;
if day <= SLRangeDay then begin
day := day - SLRangeDay;
processmagicstr(SYear-1);
for i := 12 downto 1 do begin
day := day + LMDay[i];
if day > 0 then
break;
end;
LYear := SYear - 1;
LMonth := i;
LDay := day;
end else begin
day := day - SLRangeDay;
for i := 1 to InterMonth-1 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if day <= 0 then begin
LYear := SYear;
LMonth := i;
LDay := day + LMDay[i];
end else begin
day := day - LMDay[InterMonth];
if day <= 0 then begin
LYear := SYear;
LMonth := InterMonth;
LDay := day + LMDay[InterMonth];
end else begin
LMDay[InterMonth] := InterMonthDays;
for i := InterMonth to 12 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if i = InterMonth then
LMonth := 0 - InterMonth
else
LMonth := i;
LYear := SYear;
LDay := day + LMDay[i];
end;
end;
end;
end;procedure Lunar2Solar(LYear, LMonth, LDay : integer; var SYear, SMonth, SDay : integer);
var
i, day : integer;
begin
day := 0;
SYear := LYear;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
processmagicstr(SYear);
if LMonth < 0 then
day := LMDay[InterMonth];
if LMonth <> 1 then
for i := 1 to LMonth-1 do
day := day + LMDay[i];
day := day + LDay + SLRangeDay;
if (InterMonth <> 13) and (InterMonth < LMonth) then
day := day + InterMonthDays;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
if day > 0 then begin
SYear := SYear + 1;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
end;
//i := i - 1;
day := day + SMDay[i];
//if i = 0 then begin
// i := 12;
// SYear := SYear - 1;
// day := day + 31;
//end;// else
//day := day + SMDay[i];
SMonth := i;
SDay := day;
end;end.
解决方案 »
- 我觉得embarcadero翻译成"阴巴可得肉"更加符合读音,不知道大家觉得泥?
- 如何动态的设定RemoteDataModule中的ADOConnection属性
- 怎么取得本机当前使用网卡的MAC地址?适用于98/me/2000/xp/2003。。。急。。
- 关于线程的synchronize()
- 如何在 Tpanel 控件上画出类似于Delphi界面编辑器(设计时Form)上的Grid小点?
- 各位兄弟帮我看看这个帖!!
- 如何获取鼠标点击窗体时的坐标??急!
- 用Tbarcode控件生成的条码,怎样以图形格式保存到数据库里面的image类型的字段中,
- 如何把串口数据转变为图像形式
- 请问用Delphi如何判断浏览器是否安装了Flash插件?
- Can't determine my window-handle 这个错误是什么意?我找遍帮助也没看到有关信息呀
- 為什麼在打報表時黨把DETAILBAND的QRDBText的DATESET 和 QuickRep1 的dateset 都設
這是一個國曆與農曆互相轉的Unit. 其中年份皆用民國年份, 請自行轉換 (西元年-1911 = 民國年).
***************************************************************************
*國農曆對映表之說明 : *
***************************************************************************
* 前二數字 = 閏月月份, 如果為 13 則沒有閏月 *
* 第三至第六數字 = 12 個月之大小月之2進位碼->10進位 *
* 例如: *
* 101010101010 = 2730 *
* 1 : 代表大月(30天) 0 : 代表小月(29天) ==> 1月大2月小3月大..... *
* 第七位數字為閏月天數 *
* 0 : 沒有閏月之天數 *
* 1 : 閏月為小月(29天) *
* 2 : 閏月為大月(30天) *
* 最後2位數字代表陽曆之1月1日與陰曆之1月1日相差天數 *
***************************************************************************
這對映表只有民國一年至民國一百年, 如不敷您的使用請按照上述之方式自行增加. 這個程式沒有判斷您所輸入之年,月,日是否正確, 請自行判斷. 如果轉換出來之農曆的月份是閏月則傳給您的值是***負數***
如果農曆要轉換國曆如果是閏月請輸入***負數*** 此版本為FreeWare Version : 0.1
您可以自行修改, 但最好可以將修改過之程式Mail一份給我.
如果您要用於商業用途, 請mail給我告知您的用途及原因. 作者 : 彭宏傑
E-Mail : [email protected]}