fourth_frm1.frm

倒计时用于倒计时的……包括北京时间、伦敦时间、纽约时间……

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   1920
      TabIndex        =   22
      Top             =   5760
      Width           =   1335
   End
   Begin VB.Label Label13 
      BackStyle       =   0  'Transparent
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2640
      TabIndex        =   20
      Top             =   2160
      Width           =   855
   End
   Begin VB.Label Label12 
      BackStyle       =   0  'Transparent
      Caption         =   "日"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   7320
      TabIndex        =   19
      Top             =   2160
      Width           =   615
   End
   Begin VB.Label Label11 
      BackStyle       =   0  'Transparent
      Caption         =   "分 "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   5040
      TabIndex        =   18
      Top             =   3120
      Width           =   855
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "时 "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2640
      TabIndex        =   17
      Top             =   3120
      Width           =   855
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "秒"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   7440
      TabIndex        =   16
      Top             =   3120
      Width           =   495
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "月"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   5040
      TabIndex        =   15
      Top             =   2160
      Width           =   735
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "秒"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   615
      Left            =   7200
      TabIndex        =   4
      Top             =   4680
      Width           =   615
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "天"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   615
      Left            =   4920
      TabIndex        =   3
      Top             =   4680
      Width           =   495
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   495
      Left            =   2760
      TabIndex        =   2
      Top             =   4680
      Width           =   495
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "距离 "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   20.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   1320
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nYear As Long, nDay As Long, tYear As Long, tDay As Long
Dim nSec As Long, tSec As Long
Dim okyear As Long, okday As Long, oksec As Long
Dim month As Long, numday As Long, timezone As String
Dim strNow1 As String, strNow2 As String
Dim strEnd1 As String, strEnd2 As String
Dim ly As Integer, cy As Integer
Private Sub Combo1_Click()
    Select Case Combo1.ListIndex
        Case 0
            timezone = "GMT+08:00"
            Label8.Caption = "北京时间"
            Label1.Caption = "距离"
            Timer1.Enabled = False
            Text3.Text = ""
            Text2.Text = ""
            Text1.Text = ""
        Case 1
            timezone = "GMT"
            Label8.Caption = "伦敦时间"
            Label1.Caption = "距离"
            Timer1.Enabled = False
            Text3.Text = ""
            Text2.Text = ""
            Text1.Text = ""
        Case 2
            timezone = "GMT-05:00"
            Label8.Caption = "纽约时间"
            Label1.Caption = "距离"
            Timer1.Enabled = False
            Text3.Text = ""
            Text2.Text = ""
            Text1.Text = ""
    End Select
End Sub
Private Sub Command1_Click()
            Timer1.Enabled = False
            Text1.Text = "0"
            Text2.Text = "000"
            Text3.Text = "00000"
End Sub

Private Sub Command2_Click()
    Timer1.Enabled = False
End Sub
Private Sub Command4_Click()
    End
End Sub
Private Sub Command6_Click()
    Timer1.Enabled = True
    showSecond
    showDay
    showYear
End Sub
Private Sub Form_Load()
    Label17.Caption = Now
    strEnd1 = InputBox$("请输入倒计时截止日期：（格式：月－日－年）", "请按格式输入正确的日期")
    strEnd2 = InputBox$("请输入倒计时截止时间：（格式：时：分：秒）", "请按格式输入正确的时间")
    Text7.Text = Right(strEnd1, 4)
    Text5.Text = Left(strEnd1, 2)
    Text9.Text = Mid(strEnd1, 3, 2)
    Text8.Text = Left(strEnd2, 2)
    Text4.Text = Mid(strEnd2, 3, 2)
    Text6.Text = Right(strEnd2, 2)
    tYear = Val(Right(strEnd1, 4))
    month = Val(Left(strEnd1, 2))
    If tYear Mod 4 = 0 And tYear Mod 100 <> 0 Or tYear Mod 400 = 0 Then
        ly = 1
        tDay = (Val(Left(strEnd1, 2)) - 1) * 30 + Val(Mid(strEnd1, 3, 2)) + numday
    Else
        tDay = (Val(Left(strEnd1, 2)) - 1) * 30 + Val(Mid(strEnd1, 3, 2)) + numday
    End If
    tSec = Val(Left(strEnd2, 2)) * 3600 + Val(Mid(strEnd2, 3, 2)) * 60 + Val(Right(strEnd2, 2))
End Sub

Private Sub Timer1_Timer()
    Label17.Caption = Now
    strNow1 = Format(Now, "mm/dd/yyyy")
    strNow2 = Format(Now, "hh:mm:ss")
    nYear = Val(Right(strNow1, 4))
    month = Val(Left(strNow1, 2))
    If nYear Mod 4 = 0 And nYear Mod 100 <> 0 Or nYear Mod 400 = 0 Then
        ly = 1
        nDay = 366 - (Val(Left(strNow1, 2) - 1) * 30 + Val(Mid(strNow1, 4, 2)) + numday)
    Else
        nDay = 365 - (Val(Left(strNow1, 2) - 1) * 30 + Val(Mid(strNow1, 4, 2)) + numday)
        cy = 1
    End If
    nSec = Val(Left(strNow2, 2)) * 3600 + Val(Mid(strNow2, 4, 2)) * 60 + Val(Right(strNow2, 2))
    okday = tDay + nDay - 1
    oksec = 86400 - nSec + tSec
    okyear = tYear - nYear - 1
    zonechange
    showSecond
    showDay
    showYear
End Sub
Sub showYear()
    Text1.Text = okyear
End Sub
Sub showDay()
    If okday >= 365 Then
        okyear = okyear + 1
        okday = okday - 365
    End If
    Text2.Text = okday
End Sub
Sub showSecond()
    If oksec > 86400 Then
        oksec = oksec - 86400
        okday = okday + 1
    End If
   Text3.Text = oksec
End Sub
Sub zonechange() '时区转换
    Select Case timezone
        Case "GMT+08:00"
        Case "GMT"
            oksec = oksec + 3600 * 8
        Case "GMT-05:00"
            oksec = oksec + 3600 * 8 + 3600 * 5
    End Select
End Sub
Sub someday() '天数误差处理
    If ly = 1 Then
        Select Case month
            Case 1
                numday = 0
            Case 2
                numday = 1
            Case 3
                numday = -1
            Case 4
                numday = 0
            Case 5
                numday = 0
            Case 6
                numday = 1
            Case 7
                numday = 1
            Case 8
                numday = 2
            Case 9
                numday = 3
            Case 10
                numday = 3
            Case 11
                numday = 4
            Case 12
                numday = 4
    Else
        Select Case month
            Case 1
                numday = 0
            Case 2
                numday = 1
            Case 3
                numday = 0
            Case 4
                numday = 1
            Case 5
                numday = 1
            Case 6
                numday = 2
            Case 7
                numday = 2
            Case 8
                numday = 3
            Case 9
                numday = 4
            Case 10
                numday = 4
            Case 11
                numday = 5
            Case 12
                numday = 5
    End If
End Sub