轉農曆 |
尚未結案
|
a23161
一般會員 發表:2 回覆:2 積分:0 註冊:2005-01-29 發送簡訊給我 |
|
shinjie
資深會員 發表:12 回覆:275 積分:287 註冊:2003-03-19 發送簡訊給我 |
|
a23161
一般會員 發表:2 回覆:2 積分:0 註冊:2005-01-29 發送簡訊給我 |
|
shinjie
資深會員 發表:12 回覆:275 積分:287 註冊:2003-03-19 發送簡訊給我 |
以下是轉貼的資料
{ 這是一個國歷與農曆互相轉的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 : rexpeng@ms1.hinet.net } 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 c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸'); c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥'); // Magic String : LongLife : array[1..100] 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' ); var LMDay : array[1..13] of integer; InterMonth, InterMonthDays, SLRangeDay : integer; SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 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. 取得農曆日期 procedure TForm1.Button1Click(Sender: TObject); var LYear, LMonth, LDay : integer; begin Solar2Lunar(2005-1911, 02, 02,LYear, LMonth, LDay); showmessage(inttostr(lyear) inttostr(LMonth) inttostr(LDay)); end;
------
我將在茫茫人海中尋訪我唯一之靈魂伴侶。 得之;我幸。不得;我命。 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |