我想要一个计算生辰八字的vb语言源码
你的来信已收到，已作更正。
新邮件已发出，请查收。
PS:我调试没错，你说不正确，请举例说明。不然我怎么找错误？
任务已接下~376463435@qq.com
这个是有计算方法的，只要你有计算公式我就可以计算出来的。但是前提你要有计算公式才行。
'公历转农历模块
'// 农历数据定义 //
'先以 H2B 函数还原成长度为 18 的字符串，其定义如下：
'前12个字节代表1-12月：1为大月，0为小月；压缩成十六进制(1-3位)
'第13位为闰月的情况，1为大月30天，0为小月29天；(4位)
'第14位为闰月的月份，如果不是闰月为0，否则给出月份(5位)
'最后4位为当年农历新年的公历日期，如0131代表1月31日；当作数值转十六进制(6-7位)
'农历常量(1899~2100，共202年）
Private Const ylData = "AB500D2,4BD0883," _
& "4AE00DB,A5700D0,54D0581,D2600D8,D9500CC,655147D,56A00D5,9AD00CA,55D027A,4AE00D2," _
& "A5B0682,A4D00DA,D2500CE,D25157E,B5500D6,56A00CC,ADA027B,95B00D3,49717C9,49B00DC," _
& "A4B00D0,B4B0580,6A500D8,6D400CD,AB5147C,2B600D5,95700CA,52F027B,49700D2,6560682," _
& "D4A00D9,EA500CE,6A9157E,5AD00D6,2B600CC,86E137C,92E00D3,C8D1783,C9500DB,D4A00D0," _
& "D8A167F,B5500D7,56A00CD,A5B147D,25D00D5,92D00CA,D2B027A,A9500D2,B550781,6CA00D9," _
& "B5500CE,535157F,4DA00D6,A5B00CB,457037C,52B00D4,A9A0883,E9500DA,6AA00D0,AEA0680," _
& "AB500D7,4B600CD,AAE047D,A5700D5,52600CA,F260379,D9500D1,5B50782,56A00D9,96D00CE," _
& "4DD057F,4AD00D7,A4D00CB,D4D047B,D2500D3,D550883,B5400DA,B6A00CF,95A1680,95B00D8," _
& "49B00CD,A97047D,A4B00D5,B270ACA,6A500DC,6D400D1,AF40681,AB600D9,93700CE,4AF057F," _
& "49700D7,64B00CC,74A037B,EA500D2,6B50883,5AC00DB,AB600CF,96D0580,92E00D8,C9600CD," _
& "D95047C,D4A00D4,DA500C9,755027A,56A00D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6," _
& "B4A00CB,BAA047B,B5500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D," _
& "6AA00D4,AD500C9,5B5027A,4B600D2,96E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB," _
& "76A037B,96D00D3,4AB0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4," _
& "56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B," _
& "93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA," _
& "D2E0379,C9600D1,D550781,D4A00D9,DA400CD,5D5057E,56A00D6,A6C00CB,55D047B,52D00D3," _
& "A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5A00D4,52B00CA,B27037A," _
& "69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882," _
& "D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1"
Private Const ylMd0 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五" _
& "十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 "
Private Const ylMn0 = "正二三四五六七八九十冬腊"
Private Const ylTianGan0 = "甲乙丙丁戊已庚辛壬癸"
Private Const ylDiZhi0 = "子丑寅卯辰巳午未申酉戌亥"
Private Const ylShu0 = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
'公历日期转农历
Function GetYLDate(ByVal strDate As String) As String
On Error GoTo aErr
If Not IsDate(strDate) Then Exit Function
Dim setDate As Date, tYear As Integer, tMonth As Integer, tDay As Integer
setDate = CDate(strDate)
tYear = Year(setDate): tMonth = Month(setDate): tDay = Day(setDate)
'如果不是有效有日期，退出
If tYear > 2100 Or tYear < 1900 Then Exit Function
Dim daList() As String * 18, conDate As Date, thisMonths As String
Dim AddYear As Integer, AddMonth As Integer, AddDay As Integer, getDay As Integer
Dim YLyear As String, YLShuXing As String
Dim dd0 As String, mm0 As String, ganzhi(0 To 59) As String * 2
Dim RunYue As Boolean, RunYue1 As Integer, mDays As Integer, i As Integer
'加载2年内的农历数据
ReDim daList(tYear - 1 To tYear)
daList(tYear - 1) = H2B(Mid(ylData, (tYear - 1900) * 8 + 1, 7))
daList(tYear) = H2B(Mid(ylData, (tYear - 1900 + 1) * 8 + 1, 7))
AddYear = tYear
initYL:
AddMonth = CInt(Mid(daList(AddYear), 15, 2))
AddDay = CInt(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay) '农历新年日期
getDay = DateDiff("d", conDate, setDate) + 1 '相差天数
If getDay < 1 Then AddYear = AddYear - 1: GoTo initYL
thisMonths = Left(daList(AddYear), 14)
RunYue1 = Val("&H" & Right(thisMonths, 1)) '闰月月份
If RunYue1 > 0 Then '有闰月
thisMonths = Left(thisMonths, RunYue1) & Mid(thisMonths, 13, 1) & Mid(thisMonths, RunYue1 + 1)
End If
thisMonths = Left(thisMonths, 13)
For i = 1 To 13 '计算天数
mDays = 29 + CInt(Mid(thisMonths, i, 1))
If getDay > mDays Then
getDay = getDay - mDays
Else
If RunYue1 > 0 Then
If i = RunYue1 + 1 Then RunYue = True
If i > RunYue1 Then i = i - 1
End If
AddMonth = i
AddDay = getDay
Exit For
End If
Next
dd0 = Mid(ylMd0, (AddDay - 1) * 2 + 1, 2)
mm0 = Mid(ylMn0, AddMonth, 1) + "月"
For i = 0 To 59
ganzhi(i) = Mid(ylTianGan0, (i Mod 10) + 1, 1) + Mid(ylDiZhi0, (i Mod 12) + 1, 1)
Next i
YLyear = ganzhi((AddYear - 4) Mod 60)
YLShuXing = Mid(ylShu0, ((AddYear - 4) Mod 12) + 1, 1)
If RunYue Then mm0 = "闰" & mm0
GetYLDate = "农历 " & YLyear & "(" & YLShuXing & ")年" & mm0 & dd0
aErr:
End Function
'农历转公历日期
'secondMonth 为真，则天示当 tMonth 是闰月时，取第二个月
Function GetDate(ByVal tYear As Integer, tMonth As Integer, tDay As Integer, Optional secondMonth As Boolean = False) As String
On Error GoTo aErr
If tYear > 2100 Or tYear < 1899 Or tMonth > 12 Or tMonth < 1 Or tDay > 30 Or tDay < 1 Then Exit Function
Dim thisMonths As String, ylNewYear As Date, toMonth As Integer
Dim mDays As Integer, RunYue1 As Integer, i As Integer
thisMonths = H2B(Mid(ylData, (tYear - 1899) * 8 + 1, 7))
If tDay > 29 + CInt(Mid(thisMonths, tMonth, 1)) Then Exit Function
ylNewYear = DateSerial(tYear, CInt(Mid(thisMonths, 15, 2)), CInt(Mid(thisMonths, 17, 2))) '农历新年日期
thisMonths = Left(thisMonths, 14)
RunYue1 = Val("&H" & Right(thisMonths, 1)) '闰月月份
toMonth = tMonth - 1
If RunYue1 > 0 Then '有闰月
thisMonths = Left(thisMonths, RunYue1) & Mid(thisMonths, 13, 1) & Mid(thisMonths, RunYue1 + 1)
If tMonth > RunYue1 Or (secondMonth And tMonth = RunYue1) Then toMonth = tMonth
End If
thisMonths = Left(thisMonths, 13)
mDays = 0
For i = 1 To toMonth
mDays = mDays + 29 + CInt(Mid(thisMonths, i, 1))
Next
mDays = mDays + tDay
GetDate = ylNewYear + mDays - 1
aErr:
End Function
'将压缩的阴历字符还原
Private Function H2B(ByVal strHex As String) As String
Dim i As Integer, i1 As Integer, tmpV As String
Const hStr = "0123456789ABCDEF"
Const bStr = "0000000100100011010001010110011110001001101010111100110111101111"
tmpV = UCase(Left(strHex, 3))
'十六进制转二进制
For i = 1 To Len(tmpV)
i1 = InStr(hStr, Mid(tmpV, i, 1))
H2B = H2B & Mid(bStr, (i1 - 1) * 4 + 1, 4)
Next
H2B = H2B & Mid(strHex, 4, 2)
'十六进制转十进制
H2B = H2B & "0" & CStr(Val("&H" & Right(strHex, 2)))
End Function
Private Sub Command1_Click()
Label1.Caption = GetYLDate(Text1.Text)
End Sub
做APP，支持
生辰八字计算方法
生辰八字是根据公历出生日期和出生时辰来推算一个人的年、月、日、时的八个字。计算方法如下：1. 将出生日期转换为农历日期。可以使用农历转换表或者专业的农历工具来将公历日期转换为农历日期。农历日期包括年、月、日。2. 根据农历年份确定该年的干支。干支是中国古代的计时系统，由天干（甲、乙、丙...
如何计算生辰八字?
知道什么叫生辰八字吗？用天干（一个字）和地支（一个字）组合起来，分别纪年、纪月、纪日、纪时，把出生的时刻（年月日时）用八个字来表示就是“生辰八字”。例如今天中午（11至13点），是壬寅年癸卯月乙丑日壬午时，八字就是:壬寅癸卯乙丑壬午。用这种方法纪年月日时的，只有中国的农历！所以，...
怎么算自己的生辰八字 怎么快速算生辰八字
1、例如某人出生于公元2010年5月6日8时，根据计算，生辰八字：庚寅庚辰丙辰壬辰。2、下面介绍一下具体计算方法。年柱，你可以通过黄历来查找，很方便。如果出生的年份是2014年，农历是甲午年，年柱即为甲午。3、月柱，就是用干支表示出生年月所处的节令（注意根据每月的月令而定）。具体如下：一月为...
如何算生辰八字
生辰八字，是个人出生时特定时间对应的四柱组合，由年柱、月柱、日柱和时柱四部分组成，每柱由一个天干和一个地支构成。要推算八字，需按照农历出生时间进行计算，分为四个步骤。以2023年10月3日11点15分，农历为2023年八月十九11点15分的广东广州市为例。首先，年柱由公历年尾数对应天干（3对应癸）...
生辰八字怎么算?
6、出生日期查询生辰八字:想知道自己的出生日期和生辰八字 7、出生日期查询生辰八字:如何查询生辰八字 8、出生日期查询生辰八字:用出生日期如何算出生辰八字？关键是日和时的两柱怎么算。 排“生辰八字”也称之为排“四柱”。2021年9月剖腹产吉日查询。1、求测者须报出确切的出身年月日时，阳历、...
请问生辰八字怎么算
- 日柱：以农历的干支纪日，每六十年一循环，需查万年历确定，如2010年5月6日的日柱为丙辰。- 时柱：以干支表示出生时辰，一天分为十二个时辰，每个时辰两小时，如8时为辰时，时柱为壬辰。如何推算五行？生辰八字中的天干地支与五行相对应，通过对照表可以推算出五行的属性。例如，庚寅年、庚辰月、...
怎么算一个人的生辰八字,生辰八字的简单算法
天干地支 首先要知道自己准确的出生年、月、日、时。所谓的八字就是八个字，是由人的年干支，月干支，日干支，时干支组成的，又称为年柱，月柱，日柱，时柱，每一柱都是由天干和地支构成。十天干：甲、乙、丙、丁、戊、己、庚、辛、壬、癸。十二地支：子、丑、寅、卯、辰、巳、午、未、申...
怎么测自己的生辰八字
4. 计算时辰天干的规则是：首先找出当日“日”的天干，然后将其乘以2再减去1，之后除以10取余数。余数对应的数字便是相应时辰的天干。例如，2005年11月9日的“日”天干为“丁”，计算得出子时的天干为庚。5. 生辰八字，又称四柱，是周易中用来表示一个人出生时间（年、月、日、时）的天干地支组合...
人的生辰八字是怎么算,怎么算一个人的生辰八字
提起人的生辰八字是怎么算，大家都知道，有人问怎么算一个人的生辰八字，另外，还有人想问生辰八字是怎么算的？你知道这是怎么回事？其实生辰八字怎么算？下面就一起来看看怎么算一个人的生辰八字，希望能够帮助到大家！人的生辰八字是怎么算 1、人的生辰八字是怎么算:怎么算一个人的生辰八字 生辰...
生辰八字怎么算
生辰八字，简称八字，是指一个人出生时的干支历日期；年月日时共四柱干支，每柱两字，合共八个字，故称。生辰八字在汉族民俗信仰中占有重要地位，古代汉族星相家据此推算人的命运的好坏。八字预测术在实践中不断发展，从李虚中的三柱、到徐子平的四柱，到的四柱太阳律月亮律，每一个阶梯的递进，都包含...
艾雄应力： 这个需要挺大的数据库!让对方输入相应条件,然后用if来和数据库里的对比,满足条件的输出就可以了!
石城县13431416782： 高分求计算器代码求VB或者VB.NET计算器代码如果有好的算法其 ？
艾雄应力： Option Explicit Dim strNumber As String Dim strPoint As String Dim dblNum1 As ... '是第一次单击运算符时,将输入的值先赋给第一个数,否则赋值给第二个数进行运算 If ...
石城县13431416782： 各种计算机语言的代码是怎么来的?怎样找到vb的全部代码? - ？
艾雄应力： 计算的运行都是指令来完成的,就是机器语言,就象动物,蜜蜂跳8字舞来下达采蜜指令 后来人类有了语言,通过语言来转化为指令,叫你去打猎,种田 编程也是一样,就像有中文,英语等,都是为了发指令. 但谁又能说清 中文,英语怎么来的 人类的语言在发展,会有更多的单词,编程语言也在升级,这也相通 vb的代码无法全部列出,能列出的无非基本的 if then ,do loop for next ,select case 等一些,以此而组成一些复杂算法代码. 这也类似于英文26字母,中文的横竖撇捺.但给你全部的中文汉字,有新华字典,但句子没有字典可查. 学vb可以有msdn给你参考,但也无法列出所有的代码.
石城县13431416782： 通过一个人的生日怎么算生辰八字 - ？
艾雄应力： 生辰八字或者说八字,其实是周易术语四柱的另一种说法.四柱是指人出生的时间、即年、月、日、时.在人用天干和地支各出一字相配合分别来表示年、月、日、时,如甲子年、丙申月、辛丑日、壬寅时等.每柱两字,四柱共八字,所以算命...
石城县13431416782： 我要用vb做软件,我想让他第一次打开的时候生成一个txt,然后第二次打开不生成,怎么做 - ？
艾雄应力： Option Explicit Dim i As Integer Private Sub Command1_Click() i = i + 1 If i Mod 2 <> 0 Then Open App.Path & ＂\new.txt＂ For Output As #1 Print #1, ＂ok!＂ Close #1 End If End Sub
石城县13431416782： 你好!我想学习VB语言基础,顺序结构程序设计,选择结构程序设计.要操作过程谢谢 - ？
艾雄应力： 顺序 a=1 b=2 c=3 a=b+c print a 选择 a=1 b=2 c=3 if a>b then c=a+1 else c=b+1 end if print c
石城县13431416782： 我想学习VB语言编程,需要安装什么软件? - ？
艾雄应力： visual studio迅雷上到处都是,最好还是用新一点的譬如说visual studio2003,当然还有小的http://www.gougou.com/search?search=vb&id=0 有很多你想要的 http://www.gougou.com/search?search=visual%20studio2003&restype=-1&id=10000000&ty=0 这个VS
石城县13431416782： vb中怎样计算一个字符串的子串数 - ？
艾雄应力： 用split
石城县13431416782： 我想要算一下我的生辰八字,谁会算可以帮帮我吗?我有急用啊!我是2004年3月9日五点多出生的,帮帮我,谢谢!？
艾雄应力： 八字:甲申 丁卯 丁亥 癸卯 五行缺土;木旺;日主天干为火.八字偏强,八字喜“土”,“土”就是此命的喜用神.
