Type Class_MonthCalendar Extends Class_Control
Protected : 
   Declare Function DateStrToSys(bValue As String) As SYSTEMTIME  '把字符串时间转换为系统格式时间
Public : 

   Declare Property CurSel() As SYSTEMTIME                 '返回/设置当前选择的日期
   Declare Property CurSel(ByVal pst As SYSTEMTIME)
   Declare Property SelMaxDate() As SYSTEMTIME           '返回/设置用户选择最大时间。
   Declare Property SelMaxDate(ByVal bValue As SYSTEMTIME)
   Declare Property SelMinDate() As SYSTEMTIME           '返回/设置用户选择最小时间。
   Declare Property SelMinDate(ByVal bValue As SYSTEMTIME)
   Declare Property MaxDate() As SYSTEMTIME           '返回/设置允许最大时间。如果任一元素都设置为全零，则不会为月历控件设置相应的限制。
   Declare Property MaxDate(ByVal bValue As SYSTEMTIME)
   Declare Property MinDate() As SYSTEMTIME           '返回/设置允许最小时间。如果任一元素都设置为全零，则不会为月历控件设置相应的限制。
   Declare Property MinDate(ByVal bValue As SYSTEMTIME)
   Declare Property CurSelStr() As String            '返回/设置当前选择的日期，字符格式时间，如：2019-01-01 12:12:12
   Declare Property CurSelStr(bValue As String)
   Declare Property MaxDateStr() As String           '返回/设置允许最大时间，字符格式时间，如：2019-01-01 12:12:12
   Declare Property MaxDateStr(bValue As String)
   Declare Property MinDateStr() As String           '返回/设置允许最小时间，字符格式时间，如：2019-01-01 12:12:12
   Declare Property MinDateStr(bValue As String)
   Declare Property MaxSelCount() As Long           '返回/设置可以选择的最大日期范围。
   Declare Property MaxSelCount(ByVal bValue As Long)
   Declare Property Color(ByVal iColor As Long) As Long    '返回/设置给定部分的颜色,(视觉样式时无效){1.MCSC_BACKGROUND 月份之间显示的背景颜色.MCSC_MONTHBK 月份内显示的背景颜色.MCSC_TEXT 月内显示文字的颜色.MCSC_TITLEBK 标题中显示的背景颜色.MCSC_TITLETEXT 标题中用于显示文本的颜色.MCSC_TRAILINGTEXT 标题日和尾日文本的颜色}
   Declare Property Color(ByVal iColor As Long, ByVal bValue As Long)
   Declare Property CurrentView() As Long           '返回/设置视图样式，最低操作系统Windows Vista。,{=.MCMV_MONTH 月视图.MCMV_YEAR 年度视图.MCMV_DECADE 10年视图.MCMV_CENTURY 世纪视图}
   Declare Property CurrentView(ByVal dwNewView As Long)
   Declare Property FirstDayOfWeek() As Long            '返回/设置一周中的第一天,{=.0 星期一.1 星期二.2 星期三.3 星期四.4 星期五.5 星期六. 6 星期日}
   Declare Property FirstDayOfWeek(ByVal iDay As Long)
   Declare Property Today() As SYSTEMTIME                 '返回/设置指定为“今天”的日期的日期信息。
   Declare Property Today(ByVal pst As SYSTEMTIME)
End Type

'----------------------------------------------------------------------------------------------------------------------------------------------------------------

Property Class_MonthCalendar.CurSel() As SYSTEMTIME                 '返回/设置当前选择的日期
  Dim pst As SYSTEMTIME 
   MonthCal_GetCurSel(hWndControl,@pst)
  Return pst 
End Property
Property Class_MonthCalendar.CurSel(ByVal pst As SYSTEMTIME)
  MonthCal_SetCurSel(hWndControl, @pst)
End Property 
Property Class_MonthCalendar.SelMaxDate() As SYSTEMTIME           '返回/设置用户选择最大时间。
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetSelRange(hWndControl,@pst(0))
  Return pst(1)
End Property
Property Class_MonthCalendar.SelMaxDate(ByVal bValue As SYSTEMTIME)
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetSelRange(hWndControl,@pst(0))
   pst(1)=bValue
   SNDMSG(hWndControl, MCM_SETSELRANGE, 0, Cast(lParam, (@pst(0))))
'  MonthCal_SetSelRange hWndControl,@pst(0)
End Property 
Property Class_MonthCalendar.SelMinDate() As SYSTEMTIME           '返回/设置用户选择最小时间。
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetSelRange(hWndControl,@pst(0))
  Return pst(0)
End Property
Property Class_MonthCalendar.SelMinDate(ByVal bValue As SYSTEMTIME)
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetSelRange(hWndControl,@pst(0))
   pst(0)=bValue
   SNDMSG(hWndControl, MCM_SETSELRANGE, 0, Cast(lParam, (@pst(0))))
'  MonthCal_SetSelRange hWndControl,@pst(0)
End Property   
Property Class_MonthCalendar.MaxDate() As SYSTEMTIME           '返回/设置允许最大时间。
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetRange(hWndControl,@pst(0))
  Return pst(1)
End Property
Property Class_MonthCalendar.MaxDate(ByVal bValue As SYSTEMTIME)
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetRange(hWndControl,@pst(0))
   pst(1)=bValue
'  MonthCal_SetRange hWndControl,@pst(0)
   SNDMSG(hWndControl, MCM_SETRANGE, Cast(wParam, (GDTR_MAX)), Cast(lParam, (@pst(0))))
End Property   
Property Class_MonthCalendar.MinDate() As SYSTEMTIME           '返回/设置允许最小时间。
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetRange(hWndControl,@pst(0))
  Return pst(0)
End Property
Property Class_MonthCalendar.MinDate(ByVal bValue As SYSTEMTIME)
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetRange(hWndControl,@pst(0))
   pst(0)=bValue
'  MonthCal_SetRange hWndControl,@pst(0)
  SNDMSG(hWndControl, MCM_SETRANGE, Cast(wParam, (GDTR_MIN)), Cast(lParam, (@pst(0))))
End Property    
Property Class_MonthCalendar.MaxSelCount() As Long           '返回/设置可以选择的最大日期范围。
  Return MonthCal_GetMaxSelCount(hWndControl)
End Property
Property Class_MonthCalendar.MaxSelCount(ByVal bValue As Long)
'  MonthCal_SetMaxSelCount hWndControl,bValue
   SNDMSG(hWndControl, MCM_SETMAXSELCOUNT, Cast(wParam, (bValue)), Cast(lParam, 0))
End Property    
Property Class_MonthCalendar.Color(ByVal iColor As Long) As Long            '返回/设置给定部分的颜色
  Return MonthCal_GetColor(hWndControl,iColor)
End Property
Property Class_MonthCalendar.Color(ByVal iColor As Long,ByVal bValue As Long)
'  MonthCal_SetColor hWndControl,iColor,bValue
   SNDMSG(hWndControl, MCM_SETCOLOR, iColor, bValue)
End Property    
Property Class_MonthCalendar.CurrentView() As Long           '返回/设置视图样式，
'  Return MonthCal_GetCurrentView(hWndControl)
   Return Cast(Long, SNDMSG(hWndControl, MCM_FIRST + 22, 0, 0))
End Property
Property Class_MonthCalendar.CurrentView(ByVal dwNewView As Long)
'  MonthCal_SetCurrentView hWndControl,dwNewView
   SNDMSG(hWndControl, MCM_FIRST + 32, 0, Cast(lParam, (dwNewView)))
End Property  
Property Class_MonthCalendar.FirstDayOfWeek() As Long            '返回/设置一周中的第一天,0是星期一，1是星期二，以此类推。
  Dim aa As Long 
  aa =MonthCal_GetFirstDayOfWeek(hWndControl)
  Return LoWord(aa)
End Property
Property Class_MonthCalendar.FirstDayOfWeek(ByVal iDay As Long )
'  MonthCal_SetFirstDayOfWeek hWndControl,bValue
  SNDMSG(hWndControl, MCM_SETFIRSTDAYOFWEEK, 0, iDay)
End Property  
Property Class_MonthCalendar.Today() As SYSTEMTIME                 '返回/设置指定为“今天”的日期的日期信息。
  Dim aa As SYSTEMTIME 
  MonthCal_GetToday(hWndControl,@aa)
  Return aa
End Property
Property Class_MonthCalendar.Today(ByVal pst As SYSTEMTIME)
'  MonthCal_SetToday hWndControl,@pst
   SNDMSG(hWndControl, MCM_SETTODAY, 0, Cast(lParam, (@pst)))
End Property  
Function Class_MonthCalendar.DateStrToSys(bValue As String) As SYSTEMTIME
   Dim As Long  I,a,b,c
   Dim As String y,m,d,h,mm,s
   Dim As SYSTEMTIME tt
   if len(bValue) = 0 then
      tt.wYear = Year(Now) : tt.wMonth =Month (Now) : tt.wDay = Day(Now)
      tt.wHour = Hour(Now) : tt.wMinute = Minute(Now) : tt.wSecond = Second(Now)
      return tt
   end if
   b = -1
   For i = 0 To Len(bValue) -1
      c = bValue[i]
      If c < 48 or c > 57 Then  '不是数字
         If a = 0 Then  '中间不管分割多少字符
            a = 1
            b += 1
         End If
      Else
         If b = -1 Then b = 0
         Select Case b
            Case 0
               y &=Chr(c)
            Case 1
               m &= Chr(c)
            Case 2
               d &= Chr(c)
            Case 3
               h &= Chr(c)
            Case 4
               mm &= Chr(c)
            Case 5
               s &= Chr(c)
            Case Else
               Exit For
         End Select
         a = 0
      End If
   Next
   tt.wYear = ValInt(y) : tt.wMonth = ValInt(M) : tt.wDay = ValInt(D)
   tt.wHour = ValInt(h) : tt.wMinute = ValInt(mm) : tt.wSecond = ValInt(s)
   If tt.wYear < 100 Then tt.wYear = 100
   If tt.wYear > 9999 Then tt.wYear = 9999
   If tt.wMonth < 1 Then tt.wMonth = 1
   If tt.wMonth > 12 Then tt.wMonth = 12
   If tt.wDay < 1 Then tt.wDay = 1
   If tt.wDay > 31 Then tt.wDay = 31
   if tt.wHour > 23 then tt.wHour = 23
   if tt.wMinute > 59 then tt.wMinute = 59
   if tt.wSecond > 59 then tt.wSecond = 59
   Function = tt
End Function
Property Class_MonthCalendar.CurSelStr() As String            '返回/设置时间
   Dim tt As SYSTEMTIME
   MonthCal_GetCurSel(hWndControl, @tt)
   Return tt.wYear & "-" & tt.wMonth & "-" & tt.wDay & " " & tt.wHour & ":" & tt.wMinute & ":" & tt.wSecond
End Property
Property Class_MonthCalendar.CurSelStr(bValue As String)
   Dim tt As SYSTEMTIME = DateStrToSys(bValue)
'   MonthCal_SetCurSel(hWndControl, @tt)
   SNDMSG(hWndControl, MCM_SETCURSEL, 0, Cast(lParam, (@tt)))  
End Property
Property Class_MonthCalendar.MaxDateStr() As String           '返回/设置允许最大时间。
  Dim st(1) As SYSTEMTIME
  MonthCal_GetRange(hWndControl, @st(0))
  Return st(1).wYear & "-" & st(1).wMonth & "-" & st(1).wDay & " " & st(1).wHour & ":" & st(1).wMinute & ":" & st(1).wSecond
End Property
Property Class_MonthCalendar.MaxDateStr( bValue As String)
  Dim pst(1) As SYSTEMTIME 
   MonthCal_GetRange(hWndControl,@pst(0))
   pst(1) = DateStrToSys(bValue)
'  MonthCal_SetRange hWndControl, GDTR_MAX,@pst(0)
   SNDMSG(hWndControl, MCM_SETRANGE, Cast(wParam, (GDTR_MAX)), Cast(lParam, (@pst(0))))   
End Property
Property Class_MonthCalendar.MinDateStr() As String             '返回/设置允许最小时间。
  Dim st(1) As SYSTEMTIME
  MonthCal_GetRange(hWndControl, @st(0))
  Return st(0).wYear & "-" & st(0).wMonth & "-" & st(0).wDay & " " & st(0).wHour & ":" & st(0).wMinute & ":" & st(0).wSecond
End Property
Property Class_MonthCalendar.MinDateStr(bValue As String)
   Dim pst(1) As SYSTEMTIME
   MonthCal_GetRange(hWndControl, @pst(0))
   pst(0) = DateStrToSys(bValue )
'   MonthCal_SetRange hWndControl, GDTR_MIN, @pst(0)
   SNDMSG(hWndControl, MCM_SETRANGE, Cast(wParam, (GDTR_MIN)), Cast(lParam, (@pst(0))))
End Property
