欢迎光临爱时尚女性网
 

ASP面向对象日历

2012-12-19 编辑:admin 来源:爱时尚女性网 阅读次数:791
  导读: //calendarexample.asp 面向对象日历 //CALENDAR.ASP 35 Then WeeksInMonth = 6 Else WeeksInMonth = 5 End If End Property Public Property Get Days(nIndex) If Not mbDaysInitialized Then InitDays() ...

//calendarexample.asp

<%@ Language=VBScript %>

<%Option Explicit%>




面向对象日历


<%
Dim MyCalendar
Set MyCalendar = New Calendar
MyCalendar.Top = 50
MyCalendar.Left = 150
MyCalendar.Position = "absolute"
MyCalendar.Height = "200"
MyCalendar.Width = "300"
MyCalendar.TitlebarColor = "darkblue"
MyCalendar.TitlebarFont = "arial"
MyCalendar.TitlebarFontColor = "white"
MyCalendar.TodayBGColor = "skyblue"
MyCalendar.ShowDateSelect = True
MyCalendar.OnDayClick = "javascript:alert('你点击了: $date')"
Select Case Month(MyCalendar.GetDate())
Case 1
MyCalendar.Days(1).AddActivity "New Years", "limegreen"
Case 12
MyCalendar.Days(25).AddActivity "Christmas", "limegreen"
End Select
MyCalendar.Draw()
%>



//CALENDAR.ASP

<%
Class Calendar
Public Top
Public Left
Public Width
Public Height
Public Position
Public ZIndex
Public TitlebarColor
Public TitlebarFont
Public TitlebarFontColor
Public TodayBGColor
Public OnDayClick
Public OnNextMonthClick
Public OnPrevMonthClick
Public ShowDateSelect
Private mdDate
Private msToday
Private mnDay
Private mnMonth
Private mnYear
Private mnDayMonthStarts
Private mnDaysInMonth
Private mcolDays
Private mbDaysInitialized

Private Sub Class_Initialize()
Top = 0
Left = 0
Width = 500
Height= 500
Position = "absolute"
TitlebarColor = "darkblue"
TitlebarFont = "arial"
TitlebarFontColor = "white"
TodayBGColor = "skyblue"
ShowDateSelect = True
msToday = 燜ormatDateTime(DateSerial(Year(Now()), Month(Now()), Day(Now())), 2)
zIndex = 1

Set mcolDays = Server.CreateObject("Scripting.Dictionary")
If Request("date") <> "" Then SetDate(Request("date")) Else SetDate(Now())


OnDayClick = Request.ServerVariables("SCRIPT_NAME")
OnNextMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth + 1, mnDay))
OnPrevMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth - 1, mnDay))


mbDaysInitialized = False
End Sub

Private Sub Class_Terminate()
If IsObject(mcolDays) Then
mcolDays.RemoveAll
Set mcolDays = Nothing
End If
End Sub

Public Property Get GetDate()
GetDate = mdDate
End Property

Public Property Get DaysInMonth()
DaysInMonth = mnDaysInMonth
End Property

Public Property Get WeeksInMonth()
If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
WeeksInMonth = 6
Else
WeeksInMonth = 5
End If
End Property

Public Property Get Days(nIndex)
If Not mbDaysInitialized Then InitDays()
If mcolDays.Exists(nIndex) Then Set Days = mcolDays.Item(nIndex)
End Property

Private Sub InitDays()
Dim nDayIndex
Dim objNewDay

If mcolDays.Count > 0 Then mcolDays.RemoveAll()

For nDayIndex = 1 To mnDaysInMonth
Set objNewDay = New CalendarDay
objNewDay.DateString = FormatDateTime(DateSerial(mnYear, mnMonth, nDayIndex),2)
objNewDay.OnClick = OnDayClick

mcolDays.Add nDayIndex, objNewDay
Next

mbDaysInitialized = True
End Sub

Public Sub SetDate(dDate)
mdDate = CDate(dDate)
mnDay = Day(dDate)
mnMonth = Month(dDate)
mnYear = Year(dDate)

mnDaysInMonth = 燚ay(DateAdd("d", -1, DateSerial(mnYear, mnMonth + 1, 1)))
mnDayMonthStarts = WeekDay(DateAdd("d", -(Day(CDate(dDate)) - 1), CDate(dDate)))
End Sub

Public Sub Draw()
Dim nDayCount
Dim nCellWidth, nCellHeight, nFontSizeRatio
Dim objDay

If Not mbDaysInitialized Then InitDays()

nCellWidth = CInt(Width / 7)
If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
nCellHeight = CInt((Height - 80) / 6)
Else
nCellHeight = CInt((Height - 80) / 5)
End If

nFontSizeRatio = Fix(Width / 200)

Send "

"
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""
Send ""

Send ""
For nDayCount = 1 To mnDayMonthStarts - 1
Send ""
Next

nDayCount = nDayCount - 1

For Each objDay In mcolDays.Items

If nDayCount = 7 Then
Send ""
nDayCount = 0
End If

Response.Write ""

nDayCount = nDayCount + 1
Next


If nDayCount < 7 Then
For nDayCount = nDayCount To 6
Send ""
Next
End If

Send ""

If ShowDateSelect Then
Send ""
End If

Send "
"
Send " "
Send " "
Send " "
Send " "
Send " "
Send " "
Send "
 << " & MonthName(mnMonth) & " " & mnYear & " >> 
"
Send "
S M T W T F S
 
If objDay.DateString = msToday Then Send TodayBGColor & """>" Else Send "white"">"

objDay.Draw()
Send "
 
"
DrawDateSelect()
Send "
"
Send "
"
End Sub

Private Sub DrawDateSelect()
Dim nIndex
Send "
"
Send " "
Send " "
Send " "
Send " "
Send " "
Send " "
Send "
"
End Sub

Private Sub Send(sHTML)
Response.Write sHTML & vbCrLf
End Sub


End Class




Class CalendarDay
Public DateString
Public OnClick
Private mcolActivities
Private mbActivitiesInit

Private Sub Class_Initialize()
mbActivitiesInit = False
End Sub

Private Sub Class_Terminate()
If IsObject(mcolActivities) Then
mcolActivities.RemoveAll()
Set mcolActivities = Nothing
End If
End Sub

Private Sub InitActivities()
Set mcolActivities = Server.CreateObject("Scripting.Dictionary")
mbActivitiesInit = True
End Sub

Public Sub AddActivity(sActivity, sColor)
If Not mbActivitiesInit Then InitActivities()
mcolActivities.Add mcolActivities.Count + 1, "bgcolor=""" & sColor & """>" & sActivity
End Sub

Public Sub Draw()
Dim objActivity

Send ""
Send ""
If mbActivitiesInit Then
For Each objActivity In mcolActivities.Items
Send ""
Next
End If
Send "
" & Day(DateString) & "
"
End Sub


Private Sub Send(sHTML)
Response.Write sHTML & vbCrLf
End Sub
End Class




%>

文章出自:爱时尚女性网www.aspjc.com,尊重版权是美德,转载请保留原地址,感谢合作!

 
 
链接交换请联系:QQ:790646582 首页链接要求百度快照在一周以内,不符合以上要求的各站,我们将定期把友情连接转入内页,谢谢合作。
Copyright @ 2012-2015 爱时尚女性网 保留所有权利吉ICP备14005127号-1 服务QQ:175529508 e-mail:zk8312@163.com
本站部分资源来自网友上传,如果无意之中侵犯了您的版权,请联系本站,本站将在3个工作日内删除。