全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:4221
推到 Plurk!
推到 Facebook!

轉農曆

尚未結案
a23161
一般會員


發表:2
回覆:2
積分:0
註冊:2005-01-29

發送簡訊給我
#1 引用回覆 回覆 發表時間:2005-02-02 09:43:42 IP:140.128.xxx.xxx 未訂閱
如何以我輸入之日期轉成農曆日期 ex: procedure TForm1.Button1Click(Sender: TObject); var datetime:Tdatetime; begin datetime:=strtodate(edit1.text); end;把輸入的日期2005/1/3直接轉成農曆日期格式呢??有沒有比較簡單的方法 再此先感謝。
shinjie
資深會員


發表:12
回覆:275
積分:287
註冊:2003-03-19

發送簡訊給我
#2 引用回覆 回覆 發表時間:2005-02-02 10:20:43 IP:61.59.xxx.xxx 未訂閱
可以參考 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=25382
------
我將在茫茫人海中尋訪我唯一之靈魂伴侶。
得之;我幸。不得;我命。
a23161
一般會員


發表:2
回覆:2
積分:0
註冊:2005-01-29

發送簡訊給我
#3 引用回覆 回覆 發表時間:2005-02-02 15:04:22 IP:140.128.xxx.xxx 未訂閱
那有沒有轉農曆的函數呢??
shinjie
資深會員


發表:12
回覆:275
積分:287
註冊:2003-03-19

發送簡訊給我
#4 引用回覆 回覆 發表時間:2005-02-02 15:44:36 IP:203.73.xxx.xxx 未訂閱
以下是轉貼的資料
{
   這是一個國歷與農曆互相轉的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;
------
我將在茫茫人海中尋訪我唯一之靈魂伴侶。
得之;我幸。不得;我命。
系統時間:2024-05-19 12:33:25
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!