IDC资讯中心
a vbs class calendar
calendar.vbs
<%
*************************************************************************************************
vbscript 日历 组件
赋值：
mnth 日历月份
yr 日历年份
fontsize 字体大小
columns 月份显示列数
fontface 字体样式
fontcolour 字体颜色
fillcolour 星期背景颜色
bordercolour 边框颜色
backgroundcolour 日历背景颜色
fullyearlink 全年月份连接
取值：
monthcal 月份表格
yearcal 年份表格
方法：
loadmontharray 私有方法
*************************************************************************************************
%>
<script language=javascript>
//定义整个年份查看连接函数
function showyearcal(link, year) {
if (link.indexof(?) > 0)
link = link + &year= + year
else
link = link + ?year= + year
calwin=window.open( link, calwin, toolbar=yes, scrollbars=yes, status=yes, width=680, height=480 )
if (typeof(calwin.focus) != "undefined") {
calwin.focus()
}
}
//定义月份查看连接函数
function changemonth(moveby) {
document.calform.calmonth.value = document.calform.calmonth.value – 0 + moveby;
document.calform.submit();
}
function changeyear(moveby) {
document.calform.calyear.value = document.calform.calyear.value – 0 + moveby;
document.calform.submit();
}
</script>
<style>
td.day {font-family:arial;font-size:8pt;color:black}
</style>
<%
定义日历类
class calendar
private m, y, d, weekno, montharray, fsize, fface, fcolour, bordercol, fillcol, bgcol, bigcol, singlemonth, fylink, cols, cstylesheet
声明私有变量
property let mnth(month)
if month >= 1 and month <= 12 then
m = month
end if
end property
给月份赋值
property let yr(year)
if year > 1 and year < 9999 then
y = int(year)
end if
end property
给年份赋值
property let fontsize(fs)
if fs >= 1 and fs <= 7 then
fsize = fs
end if
end property
给字体大小赋值
property let columns(c)
select case c
case 1,2,3,4,6,12
cols = c
case else
cols = 4
end select
end property
给月份行数赋值
property let fontface(ff)
if ff <> "" then
fface = ff
end if
end property
给字体样式赋值
property let fontcolour(fc)
if fc <> "" then
fcolour = fc
end if
end property
给字体颜色赋值
property let fillcolour(fc)
if fc <> "" then
fillcol = fc
end if
end property
给星期背景色赋值
property let bordercolour(bc)
if bc <> "" then
bordercol = bc
end if
end property
给边框颜色赋值
property let backgroundcolour(bgc)
if bgc <> "" then
bgcol = bgc
end if
end property
给日历背景色赋值
property let fullyearlink(fyl) fylink = fyl end property
给全年连接赋值
property let stylesheet(ss) cstylesheet = ss end property
给样式赋值
初始化日历类
private sub class_initialize
mnth = month(now)
yr = year(now) 给年份赋值
fface = "arial" 给字体样式赋值
fsize = 2 给字体大小赋值
fcolour = "black" 给字体颜色赋值
bordercol = "lightgrey" 给边框颜色赋值
fillcol = "#3399ff" 给星期背景颜色赋值
bgcol = "darkgray" 给日历背景颜色赋值
singlemonth = true 确定为当前月
fylink = "" 整个年份连接
cols = 4 整个年份中显示月份的列数
stylesheet = false 是否使用样式
end sub
定义loadmontharray方法
private sub loadmontharray
dim dte, firstdayno
redim montharray(6,7)
for d = 1 to 31
dte = dateserial(y,m,d)
if d = 1 then
firstdayno = weekday(dte)
end if
if m = month(dte) and d = day(dte) then
weekno = abs( int( ( ( firstdayno + d -1 ) /7 )*-1) )
montharray( weekno, weekday(dte) ) = d
end if
next
end sub
取得月份
property get monthcal
dim html, fontstr, colour, colspan
定义html、字体样式、颜色和表格跨度
if request.form("calmonth") <> "" then
m = int( request.form("calmonth") ) 取得传送来的月份
y = int( request.form("calyear") ) 取得传送来的年份
if m > 12 then
m = 1
y = y + 1
end if
if m < 1 then
m = 12
y = y -1
end if
end if
loadmontharray
fontstr = "<font face=""" & fface & """ size=" & fsize & " color=" & fcolour & ">"
html = "<table cellspacing=3 cellpadding=0 bgcolor=" & bgcol & " bordercolor=" & bordercol & " border=1 width=""100%"">"
使用html制作日历的显示表格
html = html & "<tr>"
if singlemonth then
html = html & "<form name=calform method=post>"
html = html & "<td align=center>" & fontstr & "<a href=javascript:changemonth(-1)><</a></td>"
html = html & "<td align=center colspan=5>" & fontstr & monthname(m)
if fylink <> "" then
html = html & " <a href=javascript:showyearcal(" & server.urlencode(fylink) & ","& y & ")>" & y & "</a>"
else
html = html & " " & y
end if
html = html & "</font></td>"
html = html & "<td align=center>" & fontstr & "<a href=javascript:changemonth(1)>></a></td>"
else
html = html & "<td align=center colspan=7>" & fontstr & monthname(m) & "</td>"
end if
html = html & "</tr>"
for d = 1 to 7
html = html & "<th width=""14%"" bgcolor=" & fillcol & ">" & fontstr & right(weekdayname(d),1) & "</font></th>"
right(weekdayname(d),1)为中文星期格式，可以显示简单格式和完全格式
英文系统简单格式为:left(weekdayname(d),1)
完全显示格式为:weekdayname(d)
next
for weekno = 1 to 6
html = html & "<tr>"
for d = 1 to 7
html = html & "<td align=""center"" "
if cstylesheet then
html = html & "class=day "
end if
if montharray(weekno,d) = "" then
montharray(weekno,d) = " "
else
if date = dateserial(y,m,montharray(weekno,d)) then
html = html & "bgcolor=" & bordercol
end if
end if
if not cstylesheet then
html = html & ">" & fontstr & montharray(weekno,d) & "</font></td>"
else
html = html & ">" & montharray(weekno,d) & "</td>"
end if
if isnumeric( montharray(weekno,d) ) then
if date = dateserial(y,m,montharray(weekno,d)) then
fontstr = replace( fontstr, bgcol, fcolour )
end if
将当前日期的背景显示为边框颜色
end if
next
html = html & "</tr>"
next
if singlemonth then
html = html & "<input type=hidden name=calmonth value=" & m & "></input>"
html = html & "<input type=hidden name=calyear value=" & y & "></input>"
如果是当前月则通过隐藏的表单传送年份和月份
html = html & "</form>"
end if
html = html & "</table>"
monthcal = html
end property
取得年份
property get yearcal
dim html, col, row, monthsave, rows
monthsave = m
singlemonth = false
if request.form("calyear") <> "" then
yr = request.form("calyear")
end if
rows = 12/cols
定义全年月份显示行数
html = html & "<table border=0><form name=calform method=post>"
html = html & "<tr><td align=center colspan=" & cols & ">"
html = html & "<font face=""" & fface & """ size=6 color=" & fcolour & ">"
if not cstylesheet then
html = html & "<a href=javascript:changeyear(-1)><</a> " & y & " <a href=javascript:changeyear(1)>></a>"
else
html = html & y
end if
html = html & "</font></td></tr>"
for row = 1 to rows
html = html & "<tr>"
for col = 1 to cols
mnth = col + ((row -1) * cols)
html = html & "<td>" & monthcal & "</td>"
next
html = html & "</tr>"
next
html = html & "<input type=hidden name=calyear value=" & y & "></input></form></table>"
通过隐藏表单来提交年份
mnth = monthsave
yearcal = html
end property
end class
%>
test.asp
<%
option explicit
response.expires = 0
response.buffer = true
%>
<html>
<head>
<%
if request.querystring("mode") = "year" then
%>
<title> year calendar </title>
<%
else
%>
<title> month calendar </title>
<%
end if
%>
</head>
<body>
<center>
<table border=0 cellspacing=0 cellpadding=0>
<tr>
<td>
<%
dim cal
set cal = new calendar
if request.querystring("mode") = "year" then
cal.yr = request.querystring("year")
response.write( cal.yearcal )
else
cal.fullyearlink = "test.asp?mode=year"
response.write( cal.monthcal )
end if
set cal = nothing
%> </td>
</tr>
</table>
</center>
</body>
</html>
<!– #include file="calendar.vbs" –>
这个程序本来是用来投稿的，但是没有使用，我还是把他公布出来，没有什么特殊的，就是对学习vbs的class有帮助。程序我做了详细的说明，大家可以很容易看懂的。
过断时间还会有好东西公布出来的，请大家期待。最为期待的估计就是vb的仿office xp风格的按钮控件代码了。不过特别的大。呵呵。
