以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  项目发布  (http://foxtable.net/bbs/list.asp?boardid=5)
----  [分享] 得意之作 《农历日历》  (http://foxtable.net/bbs/dispbbs.asp?boardid=5&id=1980)

--  作者:czy
--  发布时间:2009/3/1 22:49:00
--  [分享] 得意之作 《农历日历》

前几天下载了一个侧边栏日历,被它的界面所打动,试着想在自己的系统中也做一个。

想着容易,做起来就不是那么回事了,本身对历法知识知之甚少,结果被其中的初一、廿十、天干、地支、属相搞得晕头转向,更让人难于摆平的是节气,网上搜了半天发现都是简单的几句介绍,所留的计算式经过计算精确度太低,C++码源倒是有,可惜偶不懂^_^。


没办法,最后参考了一些资料只好自己动手,精确度应该说已经没有问题了。


为方便大家组合到自己的系统中,全部代码都放在了窗口AfterLoad事件中,大家只需将窗口存为模板后应用到自己的系统中即可。


本程序所支持节气期限:立春1900年到2399年,其他节气1900年到2199年,如发现有错请指正。


 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:农历日历.rar



后语:

这个日历是个很不起眼的东东,但却是我最为得意之作,原因很简单,因为我做到了自以为不可能做到的事。
标题的“得意之作”为自娱自乐,大家别拍砖。



将代码做了下标注:


\'...
Dim Bar As WinForm.NavBar
Bar = e.Form.Controls("NavBar1")
Bar.SelectedIndex = 1
Dim d As Date = Date.Today()
Dim str,str1 As String
Dim y,m,d1 As Integer
y = d.year
m = d.Month
d1 = d.day
e.Form.Controls("Label1").Text = Format(d, "D")
e.Form.Controls("Label3").Text = Format(d,"dddd")
\'天干地支农历年
Dim y1 As String = d.Year
Dim Tg As String = "庚|辛|壬|癸|甲|乙|丙|丁|戊|己"
Dim Tgs() As String
Tgs = Tg.split("|")
Dim Dz As String = "申|酉|戌|亥|子|丑|寅|卯|辰|巳|午|未"
Dim Dzs() As String
Dzs = DZ.split("|")
Dim Sx As String = "猴|鸡|狗|猪|鼠|牛|虎|兔|龙|蛇|马|羊|"
Dim Sxs() As String
Sxs = Sx.split("|")
\'农历月日
Dim nl As New Lunar(Date.Today())
Dim Month As String = "|正|二|三|四|五|六|七|八|九|十|冬|腊"

Dim Months() As String
Months = Month.split("|")
if nl.LeapMonth = Nothing OrElse nl.Month < nl.LeapMonth Then
    str = Months(nl.Month)
End If
if nl.LeapMonth = nl.Month Then
    str = "闰" & Months(nl.LeapMonth -1)
End If
if nl.LeapMonth > 0 Then
    if nl.Month > nl.LeapMonth Then
        str = Months(nl.Month -1)
    End If
End If
Dim Multi As String = "|初一|初二|初三|初四|初五|初六|初七|初八|初九|初十|十一|十二|十三|十四|"
Multi = Multi & "十五|十六|十七|十八|十九|廿十|廿一|廿二|廿三|廿四|廿五|廿六|廿七|廿八|廿九|卅十"
Dim Values() As String
Values = Multi.split("|")
e.Form.Controls("Label4").Text = str & "月 " & Values(nl.Day)
\'二十四节气
Dim Jq As String = "|小寒|大寒|立春|雨水|惊蛰|春分|清明|谷雨|立夏|小满|芒种|夏至|小暑|大暑|立秋|处暑|白露|秋分|寒露|霜降|立冬|小雪|大雪|冬至"
Dim Jqs() As String
Jqs = Jq.split("|")
Select Case m
    Case 1
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,5.93,6.0055)+iif(y=1982,1,0)-iif(y=2019,1,0)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0))
        Else
            str1 = int(y*0.2422+iif(y<2000,20.66,20.72)+iif(y=2082,1,0)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0))
        End If
    Case 2
        if d1<15 Then
            str1 = int(1211/5000*y+(1593+20*int(y/1900)+20*int(y/1980)+20*int(y/2100)+20*int(y/2220))/365)-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)+int((y-1)/3200)
        Else
            str1 = int(0.2422*y+iif(y>2000,19.32,19.28)+iif(y=2026,-1,0)+iif(y=1923,-1,0))-int((y-1)/4)+int((y-1)/100)-int((y-1)/400)*iif(y>0,1,0)
        End If
    Case 3
        if d1<15 Then
            str1 = int(0.2422*y+iif(y>1978,6.232,6.186))-int(y/4)+int(y/100)-int(y/400)*iif(y>0,1,0)
        Else
            str1 = int(y*0.2422+21.2477)-int(y/4)+int(y/100)-int(y/400)+IIF(y=2084,1,0)
        End If
    Case 4
        if d1<15 Then
            str1 = int(y*0.2422+5.41)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,20.708,20.7))-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 5
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,6.138,6.12))+iif(y=1911,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,21.68,21.64))+iif(y=2008,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 6
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,6.32,6.278))+iif(y=1902,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.02,21.97))+iif(y=1928,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 7
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,7.748,7.708))+iif(y=1925,1,0)+iif(y=2016,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,23.47,23.43))+iif(y=1922,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 8
        if d1<15 Then
            str1 = int(y*0.2422+iif(y< 2000,8.17,8.1))+iif(y<2002,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,23.77,23.73))-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 9
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,8.26,8.246))+iif(y=1927,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+23.6459)-int(y/4)+int(y/100)-int(y/400)+iif(y=1942,1,0)
        End If
    Case 10
        if d1<15 Then
            str1 = int(y*0.2422+8.918)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+24.038)+iif(y=2089,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 11
        if d1<15 Then
            str1 = int(y*0.2422+8.038)+iif(y=2089,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.9,22.96))+iif(y=1978,1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
    Case 12
        if d1<15 Then
            str1 = int(y*0.2422+iif(y<2000,7.72,7.78))+iif(y=1954,1,0)-int(y/4)+int(y/100)-int(y/400)
        Else
            str1 = int(y*0.2422+iif(y<2000,22.48,22.54))+iif(y=1918,-1,0)+iif(y=2021,-1,0)-int(y/4)+int(y/100)-int(y/400)
        End If
End Select
if d1 = str1 Then
    e.Form.Controls("Label5").Visible = False
    e.Form.Controls("Label6").Visible = True
    e.Form.Controls("Label6").Text = Jqs(m*2-iif(d1<15,1,0))
Else
    e.Form.Controls("Label6").Visible = False
    e.Form.Controls("Label5").Visible = True
    e.Form.Controls("Label5").Text = Tgs(y1.SubString(3)) & Dzs(y1 Mod 12) & "(" & Sxs(y1 Mod 12) & ")年"
End If

[此贴子已经被作者于2010-4-1 14:08:04编辑过]

--  作者:程兴刚
--  发布时间:2009/3/1 22:52:00
--  

狂顶,好东东,享用了!


--  作者:狐狸爸爸
--  发布时间:2009/3/1 22:54:00
--  

鼓掌,热烈鼓掌。

图片点击可在新窗口打开查看


--  作者:gaoqr
--  发布时间:2009/3/2 8:14:00
--  
好!
--  作者:kylin
--  发布时间:2009/3/2 8:54:00
--  

新思想者


--  作者:don
--  发布时间:2009/3/2 9:21:00
--  
学习!
--  作者:smileboy
--  发布时间:2009/3/2 9:27:00
--  
顶!
--  作者:舜风
--  发布时间:2009/3/2 11:48:00
--  
能不能设计一下,用户输入公历信息,程序自动算出农历,并更据农历生日自动提示用户?

玩过智能手机的,很多人都知道这功能
--  作者:czy
--  发布时间:2009/3/2 14:09:00
--  
以下是引用舜风在2009-3-2 11:48:00的发言:
能不能设计一下,用户输入公历信息,程序自动算出农历,并更据农历生日自动提示用户?

玩过智能手机的,很多人都知道这功能


这个不用我来做了,现在的狐表本身就已经支持了.


--  作者:njlcwzn
--  发布时间:2009/3/2 15:23:00
--  

顶 顶 顶 好东东!!!!!!!!!!!!!