clsmonthcalendar.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 = "clsMonthCalendar"
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

Private Const MONTHCAL_CLASS = "SysMonthCal32"
Private Const ICC_DATE_CLASSES = &H100         ' month picker, date picker, time picker, updown

' Month Calendar Control Message
Private Const MCM_FIRST = &H1000
Private Const MCM_SETCURSEL = (MCM_FIRST + 2) ' Set MC Select Date

Private hWndMC As Long


Public Property Get hWnd() As Long
    ' 取得属性（MonthView.hwnd）
    hWnd = hWndMC
End Property

Public Sub CreateMonthCalendar(hWndParent As Long, ID As Long)
    hWndMC = CreateWindowEx(0&, MONTHCAL_CLASS, vbNullString, WS_CHILD Or WS_VISIBLE, 22, _
    54, 265, 144, hWndParent, ID, App.hInstance, 0&)
End Sub


Public Function MonthCal_SetCurSel(hDlg As Long, ID As Long, I As Long)
    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, MCM_SETCURSEL, 0, SysDateTime
End Function

Private Sub Class_Initialize()
    Dim lpInitCtrls As INITCOMMONCONTROLSEXS
    lpInitCtrls.dwSize = Len(lpInitCtrls)
    lpInitCtrls.dwICC = ICC_DATE_CLASSES
    InitCommonControlsEx lpInitCtrls
    hWndMC = 0
End Sub

Private Sub Class_Terminate()
    If hWndMC <> 0 Then
        DestroyWindow hWndMC
    End If
End Sub