form1.frm

显示当前时间,上传测试 显?镜鼻笆奔?上传测试

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2595
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3900
   LinkTopic       =   "Form1"
   ScaleHeight     =   2595
   ScaleWidth      =   3900
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3120
      Top             =   1200
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   2400
      Top             =   960
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Label LShow 
      Caption         =   "Label3"
      Height          =   375
      Left            =   840
      TabIndex        =   3
      Top             =   120
      Width           =   2775
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   2040
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1440
      Visible         =   0   'False
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

Private Declare Function SetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long

Dim oldTime As String
Dim newTime As String
Dim intSec As Integer
Dim intMin As Integer

Private Sub Command1_Click()
Label1.Caption = oldTime
newTime = DateAdd("n", 1, oldTime)
Label2.Caption = newTime

SetToOldTime

oldTime = newTime
End Sub

Function SetToOldTime() As String '将时间加快
    Dim newDayTime   As SYSTEMTIME
    newDayTime.wYear = Year(newTime)
    newDayTime.wMonth = Month(newTime)
    newDayTime.wDay = Day(newTime)
    
    newDayTime.wHour = Hour(newTime)
    newDayTime.wMinute = Minute(newTime)
    newDayTime.wSecond = intSec
    
    SetLocalTime newDayTime
End Function

Function SetTime() As String '将时间修改
    Dim flag As Boolean
    flag = False
    intSec = Second(oldTime)
    
    If intSec < 28 Then
        If (intSec = 0) Or (intSec = 1) Or (intSec = 2) Or (intSec = 3) Or (intSec = 4) Then
        Else
            intSec = 29
            flag = True
        End If
    Else
        If (intSec = 30) Or (intSec = 31) Or (intSec = 32) Or (intSec = 33) Or (intSec = 34) Then
        Else
            newTime = DateAdd("n", 1, oldTime)  '将时间加快1分
            intSec = 0
            flag = True
        End If
    End If
    
End Function

Private Sub Form_Load()
    oldTime = Now       '从保存的时间中取出修改前的系统时间
    newTime = oldTime
    intSec = 0
    intMin = 0
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()

    oldTime = Now
    newTime = oldTime
    LShow.Caption = oldTime
    SetTime '将时间修改
    SetToOldTime    '以加快后的时间修改系统时间
    
    
'''LShow.Caption = Now
'''    Dim flag As Boolean
'''    flag = True
'''
'''    oldTime = Now
'''    intMin = Minute(Now)
'''    intSec = Second(Now)
''''    If (intMin Mod 10 = 4) Or (intMin Mod 10 = 9) Then
''''        If intSec < 50 Then
''''            intSec = 50
''''        Else
''''            flag = False
''''        End If
''''    Else
''''        newTime = DateAdd("n", 1, oldTime)  '将时间加快1分
''''    End If
'''
'''
'''    If intSec < 5 Then
'''        flag = False
'''    ElseIf intSec > 55 Then
'''        flag = False
'''    Else
'''        intSec = 55
'''    End If
'''
'''
'''
'''    'newTime = DateAdd("n", 1, oldTime)  '将时间加快1分
'''    If flag = True Then
'''        SetToOldTime    '以加快后的时间修改系统时间
'''    End If
'''    'oldTime = newTime
End Sub

Private Sub Timer2_Timer()
'    intSec = Second(Now)
'    If intSec > 49 Then intSec = 0
'    LShow.Caption = Now
End Sub