syscal.frm

一个自已做的日历,很好用,如果谁能把它再完善一点就再感谢不过了,谢谢谢谢.

VERSION 5.00
Begin VB.Form SysCal 
   Caption         =   "日历"
   ClientHeight    =   3735
   ClientLeft      =   6000
   ClientTop       =   4335
   ClientWidth     =   5100
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   249
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   340
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   372
      Left            =   5445
      TabIndex        =   0
      Top             =   2895
      Width           =   1212
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "欢迎使用阿鑫系列软件的日历"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   705
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   4770
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      ForeColor       =   &H80000008&
      Height          =   240
      Left            =   780
      TabIndex        =   1
      Top             =   840
      Width           =   2625
   End
End
Attribute VB_Name = "SysCal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 
Dim Calendar As CSysMonthCal32

Private Const H_MAX As Long = &HFFFF + 1
Const DTN_FIRST = (H_MAX - 760&)
Const DTN_DATETIMECHANGE = (DTN_FIRST + 1)
Private Sub cmdOK_Click()
Me.Hide
Unload Me
End Sub

Private Sub Form_Load()
'Written by Ramon Guerrero
'[e-mail]
'[e-mail]
'[e-mail]
     
    Set Calendar = New CSysMonthCal32
    
  
    
    With Calendar
        Set .Parent = Me
         
        .Create 50, 70, 270, 160
       
    End With
    
    Label1 = Format(Calendar.GetCalendarDate, "LONG DATE")
 
 
    SubClass Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnSubClass
End Sub

 

 

 
 

Public Sub ProcMsg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Result As Long)
 
Dim hdrX As NMHDR
 
On Error Resume Next
 
Select Case uMsg
 Case WM_NOTIFY
 
 CopyMemory hdrX, ByVal lParam, Len(hdrX)
 'If it's our window then get the date
 If hdrX.hwndFrom = Calendar.hWnd Or hdrX.code = DTN_DATETIMECHANGE Then
 Label1 = Format(Calendar.GetCalendarDate, "Long Date")
 End If
 
  
 End Select
   
 
End Sub

Private Sub SubClass(hWnd As Long)
On Error Resume Next
NextProcs = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UnSubClass()
Dim hWndCur As Long
hWndCur = Me.hWnd
If NextProcs Then
SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
NextProcs = 0
End If
End Sub