ASP面向对象日历实例


答案：
<%@ Language=VBScript %>
<%Option Explicit%>
<!-- #include file="calendar.asp" -->
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<TITLE>面向对象日历</TITLE>
</HEAD>
<BODY LINK="blue" ALINK="blue" VLINK="blue">
<%
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 "<small><b>New Years</b></small>", "limegreen"
  Case 12
    MyCalendar.Days(25).AddActivity "<small><b>Christmas</b></small>", "limegreen"
End Select
MyCalendar.Draw()
%>
</BODY>
</HTML>

 
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 =  FormatDateTime(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 =  Day(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 "<div id=""calendar"" style=""top: " & CStr(Top) & "px; left: " & CStr(Left) & "px; position: " & Position & "; z-index: " & ZIndex & """>"
  Send "<table border=""1"" width=""" & Width & """ height=""" & Height & """ cellspacing=""0"">"
  Send "<tr><td colspan=""7"" height=""10"" bgcolor=""" & TitlebarColor & """>"
  Send " <table border=""0"" width=""100%"" cellspacing=0>"
  Send " <tr>"
  Send " <td align=""left""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=>  Send " <td align=""center""><font size=""" & nFontSizeRatio & """ face=""" & TitlebarFont & """ color=""" & TitlebarFontColor & """><b>" & MonthName(mnMonth) & " " & mnYear & "</b></font></td>"
  Send " <td align=""right""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=>  Send " </tr>"
  Send " </table>"
  Send "</td></tr>"
  Send "<tr>"
  Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>S</small></td>"
  Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>M</small></td>"
  Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>T</small></td>"
  Send "<td height=""20"" width=""" & CStr(nCellWidth) & """ align=""center""><small>W</small><
上一个：ASP防止刷新的计数器
下一个：ASP查看网络设置代码实例
更多图片编程知识: