clsdtpicker.cls

一个clock的 vb 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDTPicker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' Load Controls Class
Private Const ICC_DATE_CLASSES = &H100         ' month picker, date picker, time picker, updown
' Name
Private Const DATETIMEPICK_CLASS = "SysDateTimePick32"

' Date Time Picker Control Message
Private Const DTM_FIRST = &H1000
Private Const DTM_SETSYSTEMTIME = (DTM_FIRST + 2)
Private Const DTM_GETSYSTEMTIME = (&H1000 + 1)
Private I As Long
Private hWndDT(66) As Long



Public Sub CreateDTPicker(hWndParent As Long, ID&, X&, Y&, nWidth&, nHeight&, Optional Style As Long)
    hWndDT(I) = CreateWindowEx(0, DATETIMEPICK_CLASS, vbNullString, Style Or WS_CHILD _
    Or WS_VISIBLE Or WS_TABSTOP, X, Y, nWidth, nHeight, hWndParent, ID, App.hInstance, 0)
    I = I + 1
End Sub

Public Function DateTime_SetSystemtime(hDlg As Long, ID As Long, I As Long)
    'DateAdd(interval, number, date) 这一日期还加上了一段时间间隔。
    Dim SysDateTime As SYSTEMTIME
    SysDateTime.wYear = Year(DateAdd("Y", I, Date))
    SysDateTime.wMonth = Month(DateAdd("Y", I, Date))
    SysDateTime.wDay = Day((DateAdd("Y", I, Date)))
    SendDlgItemMessageAny hDlg, ID, DTM_SETSYSTEMTIME, 0, SysDateTime
End Function

Private Sub Class_Initialize()
    Dim lpCtrls As INITCOMMONCONTROLSEXS
    lpCtrls.dwSize = Len(lpCtrls)
    lpCtrls.dwICC = ICC_DATE_CLASSES
    Call InitCommonControlsEx(lpCtrls)
    I = 0
End Sub
Public Property Get hWnd(hWndNumber) As Long
    ' 取得属性（MonthView.hwnd）
    hWnd = hWndDT(hWndNumber)
End Property

Private Sub Class_Terminate()
    ' 破坏所有被创建的按钮
    Dim N As Long
    If hWndDT(0) <> 0 Then
        For N = 0 To I - 1
            DestroyWindow hWndDT(N)
            hWndDT(N) = 0
        Next
    End If
End Sub