pb农历转换函数

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))
next
return ll_ret
end function
-------------------------------------------------------------------
global type of_bintofixlen from function_object
end type

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
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
elseif ll_len > al_len then
ls_ret = right(ls_ret, al_len)
end if
return ls_ret
end function
--------------------------------------------------------------
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
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
ll_len = len(ls_first)
else
ll_len = len(ls_last)
end if
ls_first = of_bintofixlen(ls_first, ll_len)
ls_last = of_bintofixlen(ls_last, ll_len)
for i = 1 to ll_len
lc_f = mid(ls_first, i, 1)
lc_l = mid(ls_last, i, 1)

lc_temp = "0"
if lc_f = "1" and lc_l = "1" then
lc_temp = "1"
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)
end prototypes

global function string of_dectobin (long al_num);string ls_ret
long ll_num
ll_num = al_num
do
ls_ret = string(ll_num - long(ll_num / 2) * 2) + ls_ret
ll_num = long(ll_num / 2)
loop while ll_num > 1
ls_ret = string(ll_num) + ls_ret
return ls_ret
end function
-------------------------------------------------
global type of_dectobin_fixlen from function_object
end type

forward prototypes
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
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
next
elseif ll_len > al_len then
ls_ret = right(ls_ret, al_len)
end if
return ls_ret
end function
------------------------

-----------------------------------------
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);//如有改进，请与作者联系
//聂振科,email:niewei@https://www.360docs.net/doc/3214617114.html,
//2004.1.14
string ls_ret,ls_str
long lunarinfo[151] = { &
19416, 19168, 42352, 21717, 53856, 55632, 91476, 22176, 39632, 21970, &
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, &
54432,120998, 46416, 22176,107956, 9680, 37584, 53938, 43344, 46423, &
27808, 46416, 86869, 19872, 42448, 83315, 21200, 43432, 59728, 27296, &
44710, 43856, 19296, 43748, 42352, 21088, 62051, 55632, 23383, 22176, &
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, &
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, &
23200, 30371, 38608, 19415, 19152, 42192,118966, 53840, 54560, 56645, &
46496, 22224, 21938, 18864, 42359, 42160, 43600,111189, 27936, 44448, &
84835 }
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
long ll_info,k,i
long ll_temp,ll_offset
boolean lb_isleap
string ls_bin,ls_code
ll_leap = 0
ll_temp = 0
//
ll_offset = daysafter(date("1900-1-30"),ad_date)


for i = 1900 to 2050

ll_sumday = 348
k = 32768 //0x8000

ll_info = lunarinfo[i - 1900 + 1]
ls_bin = of_dectobin_fixlen(ll_info,16)

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

ll_temp = of_bitand(ll_info, 65536)

if ll_temp = 0 then
ll_leapdays = 29
else
ll_leapdays = 30
end if
else
ll_leapdays = 0
end if

ll_sumday = ll_sumday + ll_leapdays

ll_offset = ll_offset - ll_sumday

if ll_offset < 1 then exit
next
ll_offset = ll_offset + ll_sumday

ll_lyear = i
lb_isleap = false
for i = 1 to 12
if ll_leap > 0 and i = ll_leap + 1 and lb_isleap = false then //èò??
lb_isleap = true
i = i - 1

ll_temp = ll_leapdays
else
k = 65536 //0x10000

ls_bin = of_dectobin(k)

ls_code = mid(ls_bin,1,len(ls_bin) - i)
k = of_bintodec(ls_code)

if of_bitand(ll_info,k) > 0 then
ll_temp = 30
else
ll_temp = 29
end if

end if
ll_offset = ll_offset - ll_temp

if ll_offset < 0 then exit

next
ll_off

set = ll_offset + ll_temp

ll_lmon = i

ll_lday = ll_offset
date ld_ldate
long ll_days
ld_ldate = date(string(ll_lyear) + "." + string(ll_lmon) + "." + string(ll_lday))
ls_str =string(ld_ldate,'yyyy.mm.dd')

return ls_str

end function
----------------------------------------------------------------------------