日历类
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' ''''
'''' Calendar Version 1.0 ''''
'''' by Xinsoft, 2004-10-22 ''''
'''' Blogchina.COM & ChinaLabs.COM ''''
'''' ''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Class Calendar
Public Lang
Public DateVal
Public PrevYLink,NextYLink
Public PrevMLink,NextMLink
'''' Temp Var
Private pWeekdaysText
'''' HTML Parameters
Public LinkStyleClass
Public Table_class
Public Table_width
Public Table_bgColor
Public Table_Title_style
Public Table_Title_bgColor
Private Table_Title_Text
Public tdBgColor_Light
Public tdBgColor_Dark
Public tdBgColor_Gray
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
'''' meta functions
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Print( str )
Response.Write str & vbCrlf
End Sub
Private Sub Echo( str )
Response.Write str
End Sub
Private Sub EchoPara( str , val )
If ""<>""&val Then Response.Write " " & str & "="""& val &""""
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
'''' HTML functions
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub PrintTableHead
Echo "<table"
EchoPara "class" , Table_class
EchoPara "width" , Table_width
EchoPara "bgColor" , Table_bgColor
Echo " cellSpacing=""1"" cellPadding=""1"""
Echo " align=""center"""
Echo " border=""0"""
Print "><tbody>"
End Sub
Private Sub PrintTableTail
Print ""
Echo "</tbody></table>"
End Sub
Private Sub PrintTableTitle
Print "<tr>"
Echo "<td"
EchoPara "style" , Table_Title_style
EchoPara "bgColor" , Table_Title_bgColor
EchoPara "colspan" , "7"
Echo ">"
Echo " <b>" & Table_Title_Text & "</b>"
Print "</td>"
Print "</tr>"
End Sub
Private sub SetWeekdaysText_CHS()
pWeekdaysText(0)="日"
pWeekdaysText(1)="一"
pWeekdaysText(2)="二"
pWeekdaysText(3)="三"
pWeekdaysText(4)="四"
pWeekdaysText(5)="五"
pWeekdaysText(6)="六"
End Sub
Private sub SetWeekdaysText_ENU()
pWeekdaysText(0)="Su"
pWeekdaysText(1)="M"
pWeekdaysText(2)="Tu"
pWeekdaysText(3)="W"
pWeekdaysText(4)="Th"
pWeekdaysText(5)="F"
pWeekdaysText(6)="Sa"
End sub
Private sub SetWeekdaysText()
Select Case Lang
Case "CHS" : SetWeekdaysText_CHS
Case "ENU" : SetWeekdaysText_ENU
Case Else : SetWeekdaysText_ENU
End select
End Sub
Private function MonthText_CHS( monthval )
Dim Str
If monthval<10 Then
Str="0"&monthval
Else
Str=monthval
End If
MonthText_CHS=Str & "月"
End function
Private function MonthText_ENU( monthval )
Select Case ""&monthval
Case "1" : MonthText_ENU="January"
Case "2" : MonthText_ENU="February"
Case "3" : MonthText_ENU="March"
Case "4" : MonthText_ENU="April"
Case "5" : MonthText_ENU="May"
Case "6" : MonthText_ENU="June"
Case "7" : MonthText_ENU="July"
Case "8" : MonthText_ENU="August"
Case "9" : MonthText_ENU="September"
Case "10" : MonthText_ENU="October"
Case "11" : MonthText_ENU="November"
Case "12" : MonthText_ENU="December"
End select
End Function
Private function MonthText( monthval )
Select Case Lang
Case "CHS" : MonthText=MonthText_CHS( monthval )
Case Else : MonthText=MonthText_ENU( monthval )
End select
End Function
Private function YearText( yearval )
Select Case Lang
Case "CHS" : YearText=yearval & "年"
Case Else : YearText=yearval
End select
End function
Private sub SetTable_Title_Text()
Dim monthval
monthval=Month(DateVal)
Dim yeartext
yeartext=Year(DateVal)
Select Case Lang
Case "CHS" : yeartext=yeartext&"年"
Case Else : yeartext=yeartext
End Select
Dim daytext
daytext=Day(DateVal)
If 10>daytext Then daytext="0" & daytext
Select Case Lang
Case "CHS" : Table_Title_Text=MonthText_CHS( monthval )
Case Else : Table_Title_Text=MonthText_ENU( monthval )
End Select
Select Case Lang
Case "CHS" : Table_Title_Text=yeartext & Table_Title_Text & daytext & "日"
Case Else : Table_Title_Text=Table_Title_Text &" "& Day(DateVal) & " , " & yeartext
End select
End Sub
Private Sub PrintWeekdaysTR()
Dim i
Print "<tr>"
For i=0 To 6
Echo "<td"
EchoPara "align" , "center"
EchoPara "valign" , "middle"
EchoPara "bgColor" , tdBgColor_Dark
Echo ">"
Select Case Lang
Case "CHS" : Echo pWeekdaysText(i)
Case "ENU" : Echo "<b>" & pWeekdaysText(i) & "</b>"
Case Else : Echo "<b>" & pWeekdaysText(i) & "</b>"
End select
Echo "</td>"
Next
Print "</tr>"
End Sub
Private Sub PrintYMChooser()
Dim M,Y
M=Month(DateVal)
Y=Year(DateVal)
Print "<tr>"
Echo "<td"
EchoPara "align","center"
EchoPara "valign","middle"
EchoPara "bgColor",tdBgColor_Dark
EchoPara "colspan","7"
Echo ">"
'''' Year chooser
Echo "<a"
EchoPara "class",LinkStyleClass
EchoPara "href",PrevYLink
Echo ">"
Echo "<span style=""FONT-FAMILY: webdings"">3</span></a><b>"& YearText(Y) &"</b>"
Echo "<a"
EchoPara "class",LinkStyleClass
EchoPara "href",NextYLink
Echo "</td>"
Echo "<span style=""FONT-FAMILY: webdings"">4</span></a>"
Echo " "
'''' Month chooser
Echo "<a"
EchoPara "class",LinkStyleClass
EchoPara "href",PrevMLink
Echo ">"
Echo "<span style=""FONT-FAMILY: webdings"">3</span></a><b>"& MonthText(M) &"</b>"
Echo "<a"
EchoPara "class",LinkStyleClass
EchoPara "href",NextMLink
Echo "</td>"
Echo "<span style=""FONT-FAMILY: webdings"">4</span></a>"
Print "</tr>"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
'''' Date Functions
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private curY,curM,curD
Private curM_BeginDateVal,curM_EndDateVal
Private curM_DaysCount
Private curM_BeginWeekday,curM_EndWeekday
Private curM_Begin_LeftDays,curM_End_RightDays
Private curM_TDCount,curM_Lines
Private CellArray,CellX,CellY
Public ItemDate
Public ItemText
Public ItemLink
Public ItemBG
Public Function Idx2D_1D( x,y )
Idx2D_1D=CellX*y+x - curM_Begin_LeftDays
If Idx2D_1D<0 Then Idx2D_1D=-1
If Idx2D_1D>=curM_DaysCount Then Idx2D_1D=-2
End function
Private Sub InitDatePara()
curY=Year(DateVal)
curM=Month(DateVal)
curD=day(DateVal)
curM_BeginDateVal=curY&"-"&curM&"-1"
curM_EndDateVal=DateAdd( "m" , 1 , curM_BeginDateVal )
curM_EndDateVal=DateAdd( "d" ,-1 , curM_EndDateVal )
curM_DaysCount=DateDiff( "d" , curM_BeginDateVal , curM_EndDateVal )+1
curM_BeginWeekday =Weekday(curM_BeginDateVal , 1 )
curM_EndWeekday =Weekday(curM_EndDateVal , 1 )
curM_Begin_LeftDays =curM_BeginWeekday-1
curM_End_RightDays =7 - curM_EndWeekday
curM_TDCount=curM_DaysCount + curM_Begin_LeftDays + curM_End_RightDays
curM_Lines =curM_TDCount/7
CellX=7
CellY=curM_Lines
ReDim CellArray( CellX,CellY )
ReDim ItemDate(curM_DaysCount)
ReDim ItemText(curM_DaysCount)
ReDim ItemLink(curM_DaysCount)
ReDim ItemBG(curM_DaysCount)
Dim i,j
For i=0 To curM_DaysCount-1
ItemDate(i)=curY&"-"&curM&"-"&CStr(i+1)
ItemText(i)=CStr(i+1)
ItemLink(i)=""
ItemBG(i) =tdBgColor_Light
If curD=i+1 Then ItemBG(i)=tdBgColor_Gray
Next
End Sub
Property Let Date(g)
DateVal=g
InitDatePara
End Property
Private Sub PrintDayTDs()
Dim i,j
Dim x
For i=0 To CellY-1
Print "<tr>"
For j=0 To CellX-1
x=Idx2D_1D(j,i)
Echo "<td"
EchoPara "style", "FONT-SIZE: 9px; FONT-FAMILY: sans-serif"
EchoPara "align", "center"
EchoPara "valign", "middle"
If x>=0 Then
EchoPara "bgColor", ItemBG(x)
Else
EchoPara "bgColor", "#ffffff"
End if
Echo ">"
If x>=0 Then
If ""=""&ItemLink(x) Then
Echo x+1
Else
Echo "<a"
EchoPara "href",ItemLink(x)
EchoPara "class",LinkStyleClass
Echo ">"
Echo x+1
Echo "</a>"
End if
Else
Echo "<img width=""0"" height=""0"" />"
End if
Print "</td>"
Next
Print "</tr>"
Next
End sub
Private Sub Class_Initialize
Lang="CHS"
DateVal=Now
InitDatePara
PrevYLink=""
NextYLink=""
PrevMLink=""
NextMLink=""
LinkStyleClass="calendar"
Table_class="caBox"
Table_width="180"
Table_bgColor="#c8ccc8"
Table_Title_style="FONT-SIZE: 9px; COLOR: #ffffff; FONT-FAMILY: sans-serif"
Table_Title_bgColor="#d56324"
tdBgColor_Light="#ffffff"
tdBgColor_Dark ="#f0f0f0"
tdBgColor_Gray ="#efefef"
ReDim pWeekdaysText(7)
SetWeekdaysText
End Sub
Private Sub Class_Terminate
End Sub
Public Sub Exec()
PrintTableHead
SetTable_Title_Text
PrintTableTitle
PrintWeekdaysTR
PrintDayTDs
PrintYMChooser
PrintTableTail
End sub
End class
%>
echo.................... 我汗。 from:asp学习网/title:日历类/ time:2006-4-28 23:48:37
本文主题日历类
