pb农历转换函数

//聂振科,email:niewei@
//2004.1.14
string ls_ret,ls_str
long lunarinfo[151] = { &
19416, 19168, 42352, 21717, 53856, 55632, 91476, 22176, 39632, 21970, &
global type of_bitand from function_object
end type
forward prototypes
global function long of_bitand (long al_first, long al_last)
end prototypes
global function long of_bitand (long al_first, long al_last);long ll_ret, i, ll_len
global type of_bintodec from function_object
end type
forward prototypes
global function long of_bintodec (string as_num)
end prototypes
global function long of_bintodec (string as_num);
long ll_ret=0
integer li_len,i
string ls_bin
ls_bin = as_num
li_len = len(ls_bin)
for i=1 to li_len
ll_ret = ll_ret + long(Mid(ls_bin,i,1)) * (2^(li_len - i))
38608, 19925, 19152, 42192, 54484, 53840, 54616, 46400, 46496,103846, &
38320, 18864, 43380, 42160, 45690, 27216, 27968, 44870, 43872, 38256, &
19189, 18800, 25776, 29859, 59984, 27480, 21952, 43872, 38613, 37600, &
global type of_day_to_lunar from function_object
end type
forward prototypes
global function string of_day_to_lunar (date ad_date)
end prototypes
global function string of_day_to_lunar (date ad_date);//如有改进，请与作者联系
global function string of_dectobin_fixlen (long al_num, long al_len)
end prototypes
global function string of_dectobin_fixlen (long al_num, long al_len);string ls_ret
String ls_first, ls_last, ls_result
char lc_f, lc_l, lc_temp
ls_result = ""
ls_first = of_dectobin(al_first)
ls_last = of_dectobin(al_last)
if len(ls_first)<=len(ls_last) then
long ll_len, i
ls_ret = of_dectobin(al_num)
ll_len = len(ls_ret)
if ll_len < al_len then
for i=1 to (al_len - ll_len)
ls_ret = "0" + ls_ret
long ll_year,ll_mon,ll_day
long ll_lyear,ll_lmon,ll_lday
//
ll_year = year(ad_date)
ll_mon = month(ad_date)
ll_day = day(ad_date)
double ld_num
long ll_leap,ll_sumday,ll_leapdays
for k = 1 to 12
ll_sumday = ll_sumday + integer(left(right(ls_bin,k + 4),1))
next
ll_leap = of_bitand(ll_info,15)
if ll_leap > 0 then
return ls_ret
end function
-------------------------------------------------
global type of_dectobin_fixlen from function_object
end type
forward prototypes
long ll_len, i
ls_ret = as_num
ll_len = len(ls_ret)
if ll_len < al_len then
for i = 1 to (al_len - ll_len)
ls_ret = "0" + ls_ret
next
next
return ll_ret
end function
-------------------------------------------------------------------
global type of_bintofixlen from function_object
end type
elseif ll_len > al_len then
ls_ret = right(ls_ret, al_len)
end if
return ls_ret
end function
--------------------------------------------------------------
forward prototypes
global function string of_bintofixlen (string as_num, long al_len)
end prototypes
global function string of_bintofixlen (string as_num, long al_len);string ls_ret
next
elseif ll_len > al_len then
ls_ret = right(ls_ret, al_len)
end if
return ls_ret
end function
-----------------------------------------------------------------
23200, 30371, 38608, 19415, 19152, 42192,118966, 53840, 54560, 56645, &
46496, 22224, 21938, 18864, 42359, 42160, 43600,111189, 27936, 44448, &
84835 }
ll_temp = of_bitand(ll_info, 65536)
51552, 55636, 54432, 55888, 30034, 22176, 43959, 9680, 37584, 51893, &
43344, 46240, 47780, 44368, 21977, 19360, 42416, 86390, 21168, 43312, &
31060, 27296, 44368, 23378, 19296, 42726, 42208, 53856, 60005, 54576, &
19168, 42422, 42192, 53840,119381, 46400, 54944, 44450, 38320, 84343, &
18800, 42160, 46261, 27216, 27968,109396, 11104, 38256, 21234, 18800, &
25958, 54432, 59984, 28309, 23248, 11104,100067, 37600,116951, 51536, &
end if
ls_result = ls_result + lc_temp
next
ll_ret = of_bintodec(ls_result)
return ll_ret
end function
----------------------------------------------------------
global type of_dectobin from function_object
end type
forward prototypes
global function string of_dectobin (long al_num)