vb源码下载？vb下载手机版

我想要一个计算生辰八字的vb语言源码

这个是有计算方法的，只要你有计算公式我就可以计算出来的。但是前提你要有计算公式才行。

'公历转农历模块

'//农历数据定义//

'先以 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 yl*****0="子丑寅卯辰巳午未申酉戌亥"

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, thi**onths 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

thi**onths= Left(daList(AddYear), 14)

RunYue1= Val("&H"& Right(thi**onths, 1))'闰月月份

If RunYue1> 0 Then'有闰月

thi**onths= Left(thi**onths, RunYue1)& Mid(thi**onths, 13, 1)& Mid(thi**onths, RunYue1+ 1)

End If

thi**onths= Left(thi**onths, 13)

For i= 1 To 13'计算天数

mDays= 29+ CInt(Mid(thi**onths, 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(yl*****0,(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 thi**onths As String, ylNewYear As Date, toMonth As Integer

Dim mDays As Integer, RunYue1 As Integer, i As Integer

thi**onths= H2B(Mid(ylData,(tYear- 1899)* 8+ 1, 7))

If tDay> 29+ CInt(Mid(thi**onths, tMonth, 1)) Then Exit Function

ylNewYear= DateSerial(tYear, CInt(Mid(thi**onths, 15, 2)), CInt(Mid(thi**onths, 17, 2)))'农历新年日期

thi**onths= Left(thi**onths, 14)

RunYue1= Val("&H"& Right(thi**onths, 1))'闰月月份

toMonth= tMonth- 1

If RunYue1> 0 Then'有闰月

thi**onths= Left(thi**onths, RunYue1)& Mid(thi**onths, 13, 1)& Mid(thi**onths, RunYue1+ 1)

If tMonth> RunYue1 Or(secondMonth And tMonth= RunYue1) Then toMonth= tMonth

End If

thi**onths= Left(thi**onths, 13)

mDays= 0

For i= 1 To toMonth

mDays= mDays+ 29+ CInt(Mid(thi**onths, 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

VB制作小游戏源代码

猜数字

建一个文本文档，输入以下代码，后缀改为.frm用vb打开就可以了

以下是程序源码：

VERSION 5.00

Begin VB.Form Form1

BorderStyle= 3'Fixed Dialog

Caption="猜数游戏"

ClientHeight= 3900

ClientLeft= 45

ClientTop= 435

ClientWidth= 4680

LinkTopic="Form1"

MaxButton= 0'False

MinButton= 0'False

ScaleHeight= 3900

ScaleWidth= 4680

ShowInTaskbar= 0'False

StartUpPosition= 3'窗口缺省

Begin VB.CommandButton Command2

Caption="重新开始"

Height= 615

Left= 2640

TabIndex= 2

Top= 2760

Width= 1095

End

Begin VB.CommandButton Command1

Caption="确定"

Height= 615

Left= 840

TabIndex= 1

Top= 2760

Width= 1095

End

Begin VB.TextBox Text1

Height= 375

Left= 1200

TabIndex= 0

Top= 2040

Width= 2055

End

Begin VB.Label Label9

Caption="戏"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H000080FF&

Height= 615

Left= 3720

TabIndex= 11

Top= 240

Width= 615

End

Begin VB.Label Label8

Caption="游"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H00808080&

Height= 615

Left= 3240

TabIndex= 10

Top= 240

Width= 615

End

Begin VB.Label Label7

Caption="数"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H0000FFFF&

Height= 495

Left= 2760

TabIndex= 9

Top= 240

Width= 615

End

Begin VB.Label Label6

Caption="猜"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H00FF00FF&

Height= 495

Left= 2280

TabIndex= 8

Top= 240

Width= 735

End

Begin VB.Label Label5

Caption="入"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H00FF0000&

Height= 615

Left= 1800

TabIndex= 7

Top= 240

Width= 855

End

Begin VB.Label Label4

Caption="进"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H0000FF00&

Height= 735

Left= 1320

TabIndex= 6

Top= 240

Width= 735

End

Begin VB.Label Label3

Caption="迎"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H00FFFF00&

Height= 735

Left= 840

TabIndex= 5

Top= 240

Width= 735

End

Begin VB.Label Label2

Caption="欢"

BeginProperty Font

Name="宋体"

Size= 24

Charset= 134

Weight= 400

Underline= 0'False

Italic= 0'False

Strikethrough= 0'False

EndProperty

ForeColor=&H000000FF&

Height= 615

Left= 360

TabIndex= 4

Top= 240

Width= 495

End

Begin VB.Label Label1

Caption="我这儿有1~10的整数，你猜猜看他是多少......"

Height= 375

Left= 480

TabIndex= 3

Top= 1320

Width= 3855

End

End

Attribute VB_Name="Form1"

Attribute VB_GlobalNameSpace= False

Attribute VB_Creatable= False

Attribute VB_PredeclaredId= True

Attribute VB_Exposed= False

Dim x As Integer, y As Integer, z As Integer

Dim cishu As Integer

Private Sub Command1_Click()

If cishu= 3 Then MsgBox"已经猜3次了，这个数是"& x: Exit Sub

y= Val(Text1.Text)

If Text1.Text="" Or Not IsNumeric(Text1.Text) Then

MsgBox"输入有误！请重新输入数字", 48

Text1.Text=""

Text1.SetFocus

Exit Sub

End If

cishu= cishu+ 1

Select Case x- y

Case Is< 0

z= MsgBox("你猜数大了，请重猜。注意：你只有三次机会", 48+ 1)

Text1.Text=""

Text1.SetFocus

Case Is> 0

z= MsgBox("你猜数小了，请重猜。注意：你只有三次机会", 48+ 1)

Text1.Text=""

Text1.SetFocus

Case Else

z= MsgBox("恭喜你猜中了！", 1)

End Select

End Sub

Private Sub Command2_Click()

cishu= 0

Randomize Timer

x= Int((Rnd* 10)+ 1)

End Sub

Private Sub Form_Load()

cishu= 0

Randomize Timer

x= Int((Rnd* 10)+ 1)

End Sub

代码结束

卓7358/

欢迎来我空间

vb小游戏源代码

Rem窗体创建三个单选框按钮，Option1、Option2、Option3。

小游戏是一个较模糊的概念，它是相对于体积庞大的单机游戏及网络游戏而言的，泛指所有体积较小、玩法简单的游戏，通常这类游戏以休闲益智类为主，有单机版有网页版，在网页上嵌入的多为FLASH格式。

当下小游戏主要是指在线玩的flash版本游戏，统称小游戏，其实小游戏还包含单机游戏，小型游戏机等。一般游戏大小小于10m的游戏都统称为小游戏，一些街机类小游戏。因其游戏安装简便，耐玩性强，无依赖性而广受白领及小朋友的喜爱。

小游戏”这个词的型含义其实很简单，它不是一些大的游戏，不必花费更多的时间和精力。

小游戏是原始的游戏娱乐方式，小游戏本身是为了叫人们在工作，学习后的一种娱乐、休闲的一种方式，不是为了叫玩家为之花费金钱、花费精力，更不是叫玩家为他痴迷。

小游戏也可以理解为“Flash游戏”，是以SWF为后缀的游戏的总称.这些游戏是通过Flash软件和 Flash编程语言 Flash ActionScript制作而成。

由于Flash是矢量软件，所以小游戏放大后几乎不影响画面效果。Flash小游戏是一种新兴起的游戏形式，以游戏简单，操作方便，绿色，无需安装，文件体积小等优点渐渐被广大网友喜爱。

关于vb源码下载的内容到此结束，希望对大家有所帮助。