急!VB制作简易时钟

‘可以使用API进行实现

’新建一个类模块 命名为 clsTimer , 添加如下代码。

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _

Source As Any, ByVal Length As Long)

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Event Timer()

Dim m_idTimer As Long

Dim m_Enabled As Boolean

Dim m_Interval As Long

Dim m_lTimerProc As Long

Private Sub Class_Initialize()

m_Interval = 50

m_lTimerProc = GetClassProcAddr(8)

End Sub

Private Sub Class_Terminate()

If m_idTimer <> 0 Then KillTimer 0, m_idTimer

End Sub

Public Property Get Interval() As Long

Interval = m_Interval

End Property

Public Property Let Interval(ByVal New_Value As Long)

If New_Value >= 0 Then m_Interval = New_Value

End Property

Public Property Get Enabled() As Boolean

Enabled = m_Enabled

End Property

Public Property Let Enabled(ByVal New_Value As Boolean)

m_Enabled = New_Value

If m_idTimer <> 0 Then KillTimer 0, m_idTimer

If New_Value And m_Interval > 0 Then

m_idTimer = SetTimer(0, 0, m_Interval, m_lTimerProc)

End If

End Property

Private Function GetClassProcAddr(ByVal Index As Long, Optional ParamCount As Long = 4, Optional HasReturnValue As Boolean) As Long

Static lReturn As Long, pReturn As Long

Static AsmCode(50) As Byte

Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long

pThis = ObjPtr(Me)

CopyMemory pVtbl, ByVal pThis, 4

CopyMemory pFunc, ByVal pVtbl + (6 + Index) 4, 4

pReturn = VarPtr(lReturn)

For i = 0 To UBound(AsmCode)

AsmCode(i) = &H90

Next

AsmCode(0) = &H55

AsmCode(1) = &H8B: AsmCode(2) = &HEC

AsmCode(3) = &H53

AsmCode(4) = &H56

AsmCode(5) = &H57

If HasReturnValue Then

AsmCode(6) = &HB8

CopyMemory AsmCode(7), pReturn, 4

AsmCode(11) = &H50

End If

For i = 0 To ParamCount - 1

AsmCode(12 + i 3) = &HFF

AsmCode(13 + i 3) = &H75

AsmCode(14 + i 3) = (ParamCount - i) 4 + 4

Next

i = i 3 + 12

AsmCode(i) = &HB9

CopyMemory AsmCode(i + 1), pThis, 4

AsmCode(i + 5) = &H51

AsmCode(i + 6) = &HE8

CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4

If HasReturnValue Then

AsmCode(i + 11) = &HB8

CopyMemory AsmCode(i + 12), pReturn, 4

AsmCode(i + 16) = &H8B

AsmCode(i + 17) = &H0

End If

AsmCode(i + 18) = &H5F

AsmCode(i + 19) = &H5E

AsmCode(i + 20) = &H5B

AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5

AsmCode(i + 23) = &H5D

AsmCode(i + 24) = &HC3

GetClassProcAddr = VarPtr(AsmCode(0))

End Function

Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

RaiseEvent Timer

End Sub

‘新建一个窗体， 复制以下代码。

Dim WithEvents Timer As clsTimer

Private Sub Form_Load()

Set Timer = New clsTimer

TimerInterval = 1000

TimerEnabled = True

End Sub

Private Sub Timer_Timer()

MeCls

Print Now

End Sub

=======================================================================

=======================================================================

'还有一种比较简单的，不过效果没有上面的好

Private Sub Form_Load()

Dim ot As Single

MeShow

Do While True

ot = Timer

MeCls

Print Now

Do While Not Timer - ot >= 1

DoEvents

Loop

Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)

End

End Sub

如下代码可实现与电脑时钟同步精度的倒记时功能,修改sum_zj1的设置值可改变倒记时值

Option Explicit

Dim sum_zj As Integer

Dim sum_zj1 As Integer

Private Sub Form_Load()

sum_zj = 0: sum_zj1 = 20 '倒记时60秒

Text1 = sum_zj: Text2 = sum_zj1

End Sub

Private Sub Timer1_Timer()

If Label1Caption <> CStr(Time$) Then

Label1Caption = Time$

sum_zj = sum_zj + 1

Text1 = sum_zj

'3秒校准一次

If sum_zj >= 3 And sum_zj1 > 0 Then

sum_zj1 = sum_zj1 - 1

sum_zj = sum_zj - 3

Text2 = sum_zj1

ElseIf sum_zj1 <= 0 Then

Form1BackColor = vbRed

Timer1Enabled = False

End If

End If

End Sub

'用一个标签控件和一个计时器控件简单的模拟一下

Private Sub Form_Load()

With Label1

Width = 1935 '宽度

Height = 455 '高度

BackColor = vbBlack '背景黑色

ForeColor = vbGreen '文字绿色

Alignment = 2 '文字居中

FontBold = True '粗体显示

FontSize = 20 '字体大小,还可以去下载个液晶字体设置一下FontName

Caption = Time

End With

Timer1Interval = 1000 '计时器间隔时间为1秒

End Sub

Private Sub Timer1_Timer()

Label1Caption = Time

End Sub

以上就是关于急!VB制作简易时钟全部的内容，包括:急!VB制作简易时钟、关于vb6.0环境下一个时钟到记时的正确程序，请高手赐教！、用vb设计时钟等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！