syscal.frm

用visual basic 6.0 开发的超市管理信息系统！

VERSION 5.00
Begin VB.Form Syscal 
   Caption         =   "Form1"
   ClientHeight    =   3390
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3660
   LinkTopic       =   "Form1"
   ScaleHeight     =   3390
   ScaleWidth      =   3660
   StartUpPosition =   3  '窗口缺省
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "请单击选择日期"
      BeginProperty Font 
         Name            =   "华文中宋"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   705
      Left            =   1170
      TabIndex        =   1
      Top             =   30
      Width           =   3225
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Height          =   645
      Left            =   1230
      TabIndex        =   0
      Top             =   630
      Width           =   3345
   End
End
Attribute VB_Name = "Syscal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

 
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, 180, 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")
 dt = Label1
 End If
 

 End Select
   
   Me.Hide
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