線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:7814
推到 Plurk!
推到 Facebook!

萬年曆元件 (附原始碼)For D5

 
flyup
資深會員


發表:280
回覆:508
積分:385
註冊:2002-04-15

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-04-01 19:13:33 IP:61.216.xxx.xxx 未訂閱
萬年曆元件 For D5(附原始碼) 本元件參考: 【Delphi】【轉貼】萬年曆<原始碼> http://delphi.ktop.com.tw/topic.php?topic_id=26120 已變為可視元件,拖曳至表單即可使用! 因為你!再大的難題,更顯得容易!
附加檔案:27937_萬年曆元件.zip
flyup
資深會員


發表:280
回覆:508
積分:385
註冊:2002-04-15

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-04-01 19:53:58 IP:61.216.xxx.xxx 未訂閱
//萬年曆元件 使用方式範例教學    unit Unit1;    interface    uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   ComCtrls, StdCtrls, Grids, cal;    type   TForm1 = class(TForm)     RexCalendar1: TRexCalendar;     Button1: TButton;     Button2: TButton;     Button3: TButton;     Button4: TButton;     Edit1: TEdit;     Label1: TLabel;     Label2: TLabel;     Edit2: TEdit;     Label3: TLabel;     Edit3: TEdit;     Label4: TLabel;     Edit4: TEdit;     Label5: TLabel;     Label6: TLabel;     Edit5: TEdit;     Label7: TLabel;     Edit6: TEdit;     Label8: TLabel;     Edit7: TEdit;     Label9: TLabel;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);     procedure Button3Click(Sender: TObject);     procedure Button4Click(Sender: TObject);     procedure RexCalendar1Change(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;    var   Form1: TForm1;    implementation    {$R *.DFM}    procedure TForm1.Button1Click(Sender: TObject); begin RexCalendar1.PrevYear; edit1.text:=Inttostr(RexCalendar1.Year);//西元年 edit4.text:=Inttostr(RexCalendar1.LYear);//民國年 edit5.text:=RexCalendar1.LYearName;//農曆年 edit2.text:=Inttostr(RexCalendar1.Month); //月 edit6.text:=Inttostr(RexCalendar1.LMonth);//農曆月 edit3.text:= Inttostr(RexCalendar1.Day); //日 edit7.text:=  Inttostr(RexCalendar1.LDay); //農曆日 end;    procedure TForm1.Button2Click(Sender: TObject); begin RexCalendar1.NextYear; edit1.text:=Inttostr(RexCalendar1.Year); //西元年 edit4.text:=Inttostr(RexCalendar1.LYear);//民國年 edit5.text:=RexCalendar1.LYearName;//農曆年 edit2.text:=Inttostr(RexCalendar1.Month); //月 edit6.text:=Inttostr(RexCalendar1.LMonth);//農曆月 edit3.text:= Inttostr(RexCalendar1.Day); //日 edit7.text:=  Inttostr(RexCalendar1.LDay); //農曆日 end;    procedure TForm1.Button3Click(Sender: TObject); begin RexCalendar1.PrevMonth; edit2.text:=Inttostr(RexCalendar1.Month); //月 edit6.text:=Inttostr(RexCalendar1.LMonth);//農曆月 edit3.text:= Inttostr(RexCalendar1.Day); //日 edit7.text:=  Inttostr(RexCalendar1.LDay); //農曆日 end; procedure TForm1.Button4Click(Sender: TObject); begin RexCalendar1.NextMonth; edit2.text:=Inttostr(RexCalendar1.Month); //月 edit6.text:=Inttostr(RexCalendar1.LMonth);//農曆月 edit3.text:= Inttostr(RexCalendar1.Day); //日 edit7.text:=  Inttostr(RexCalendar1.LDay); //農曆日 end;    procedure TForm1.RexCalendar1Change(Sender: TObject); begin edit3.text:= Inttostr(RexCalendar1.Day); //日 edit7.text:=  Inttostr(RexCalendar1.LDay); //農曆日 end;    end.    因為你!再大的難題,更顯得容易!
flyup
資深會員


發表:280
回覆:508
積分:385
註冊:2002-04-15

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-04-02 10:50:03 IP:61.217.xxx.xxx 未訂閱
(請注意:本程式只能顯示到民國100年) 若要更改: 請參考 http://delphi.ktop.com.tw/topic.php?topic_id=25433 http://delphi.ktop.com.tw/FORUM.asp?FORUM_ID=69 因為你!再大的難題,更顯得容易! 發表人 - flyup 於 2003/04/02 23:16:48
flyup
資深會員


發表:280
回覆:508
積分:385
註冊:2002-04-15

發送簡訊給我
#4 引用回覆 回覆 發表時間:2003-04-02 11:57:05 IP:61.217.xxx.xxx 未訂閱
完整參考資料:    REXCAL.ZIP  http://www.vclxx.org/DELPHI/D32FREE/REXCAL.ZIP 國曆與農曆合而為一的月曆 ,並提供農曆與西洋曆的轉換單元,此版不需要 Delphi 3.0 的中文應用組件,(附原始程式碼),作者:彭宏傑。         因為你!再大的難題,更顯得容易!
flyup
資深會員


發表:280
回覆:508
積分:385
註冊:2002-04-15

發送簡訊給我
#5 引用回覆 回覆 發表時間:2003-04-02 12:16:14 IP:61.217.xxx.xxx 未訂閱
存成Lunar.pas檔..取代原先的Lunar.pas檔, 就可以到民國111年!! { 這是一個國曆與農曆互相轉的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 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'); //111 var 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. 因為你!再大的難題,更顯得容易!
cmf
尊榮會員


發表:84
回覆:918
積分:1032
註冊:2002-06-26

發送簡訊給我
#6 引用回覆 回覆 發表時間:2003-04-02 12:18:46 IP:61.218.xxx.xxx 未訂閱
哈哈 感謝分享 再大的難題,只要有 F IR 一切搞定    僅供參考,歡迎繼續發言
------
︿︿
esp_pzj
初階會員


發表:32
回覆:70
積分:40
註冊:2007-02-09

發送簡訊給我
#7 引用回覆 回覆 發表時間:2012-06-10 14:44:05 IP:61.225.xxx.xxx 訂閱
   *  第三至第六數字 = 12 個月之大小月之2進位碼->10進位        *
* 例如: *
* 101010101010 = 2730 *
* 1 : 代表大月(30天) 0 : 代表小月(29天) ==> 1月大2月小3月大..... *
'04 2986 1 22'


101年 2986 二進位為 010101011101
請問如何得到 010101011101
是以一月份所在農曆 29日為0
二月份所在農曆 30日為1
三月份所在農曆 29日為0
四月份所在農曆 30日為1
五月份所在農曆 29日為0
六月份所在農曆 30日為1
七月份所在農曆 29日為0
八月份所在農曆 30日為1
九月份所在農曆 30日為1
十月份所在農曆 30日為1
十一月份所在農曆 29日為0
十二月份所在農曆 30日為1

還是別的方法
我想計算 101年至 200年 謝謝!
------
學藝不精 謝多多指教
P.D.
版主


發表:603
回覆:4038
積分:3874
註冊:2006-10-31

發送簡訊給我
#8 引用回覆 回覆 發表時間:2012-08-06 21:54:51 IP:118.160.xxx.xxx 未訂閱
你只能一年一年的查農民曆, 小月0, 大月1 的方式手動算下來, 別無他法
不過我現在遭遇一個問題,
就是在今年(民國101年), 這套算法是不準的, 102年又對了
這是 101年(2012) 的設定值 '042986122'
閏04月, 1-12為2986, 有閏月1 國曆距農曆初一前, 共22日差
數據沒有問題,
在2012年1月31 算出是 元月初九, 也沒有問題
但在 2012年2月1日, 竟然又顯示是 元月初八, 2/2 是元月初九....
現在不知問題在那, 因為出現在 Solar2Lunar() 這組 function 計算上好像有問題

===================引 用 esp_pzj 文 章===================
* 第三至第六數字 = 12 個月之大小月之2進位碼->10進位 *
* 例如: *
* 101010101010 = 2730 *
* 1 : 代表大月(30天) 0 : 代表小月(29天) ==> 1月大2月小3月大..... *
'04 2986 1 22'


101年 2986 二進位為 010101011101
請問如何得到 010101011101
是以一月份所在農曆 29日為0
二月份所在農曆 30日為1
三月份所在農曆 29日為0
四月份所在農曆 30日為1
五月份所在農曆 29日為0
六月份所在農曆 30日為1
七月份所在農曆 29日為0
八月份所在農曆 30日為1
九月份所在農曆 30日為1
十月份所在農曆 30日為1
十一月份所在農曆 29日為0
十二月份所在農曆 30日為1

還是別的方法
我想計算 101年至 200年 謝謝!
系統時間:2024-04-26 23:48:27
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!