Question

为什么我的vb程序运行不了 程序对了的

程序；
'窗体的单击事件
Private Sub Text1_Click()
Form1.FontName = 楷体
Form1.FontSize = 20
Form1.FontBold = True
Form1.BackColor = vbGreen '设置窗体的背景色为绿色
Form1.ForeColor = vbWhite '设置窗体的前景色为白色
Form1.CurrentX = 500 '设置文本输出的x坐标
Form1.CurrentY = 300 '设置文本的y坐标
Form1.Print '欢饮使用vb6.0
End Sub
'窗体的双击事件
Private Sub form_dblclick【】()
Form1.Cls '清除窗体的文字

End Sub
求大神详解 谢谢

Answer 1

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