ASP中时间采集源程序(转)

This is an ASP page, which is supposed to be opened in a new browser window, it automatically resizes
to a client's resolution, displaying month view with a possibility to pick a date, which is then inserted
into a opener page control (like input type "text" control), whose reference is passed as an argument to
this ASP page




code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!



'**************************************
' Name: ASP Date Picker
' Description:This is an ASP page, which
' is supposed to be opened in a new browse
' r window, it automatically resizes to a
' client's resolution, displaying month vi
' ew with a possibility to pick a date, wh
' ich is then inserted into a opener page
' control (like input type "text" control)
' , whose reference is passed as an argume
' nt to this ASP page
' By: Vadim Maslov
'
'
' Inputs:2 possible input arguments: dat
' e to display month for (if none - today'
' s month is automatic default) + opener p
' age control name: calendar.asp?date=10/1
' 2/2000&ctl=calendar
'
' Returns:None
'
'Assumes:None
'
'Side Effects:Code probably needs to be
' adjusted if a server's Regional settings
' are not American
'
'Warranty:
'code provided by Planet Source Code(tm)
' (www.Planet-Source-Code.com) 'as is', wi
' thout warranties as to performance, fitn
' ess, merchantability,and any other warra
' nty (whether expressed or implied).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************


Option Explicit
Const TOP_COORDINATE = 30
Dim curDate
Dim daysCount
Dim lastDay
Dim firstDay
Dim i
Dim topC
Dim leftC
Dim tempDate
Dim curMonth
Dim curYear
Dim calHTML
Dim pDate
Dim curMonthText
Dim rowCount
Dim nextMonth
Dim prevMonth
Dim retControl
curDate = Request("date")
retControl = Request("ctl")
If IsDate(curDate) Then pDate = FormatDateTime(curDate, 0)
If curDate = "" Then
curDate = Now()
Else
If IsDate(curDate) Then curDate = Month(curDate) & "/" & Day(curDate) & "/" & Year
(curDate)
End If
If IsDate(curDate) Then
curMonth = Month(curDate)
curMonthText = TextMonth(curMonth) & "-" & Year(curDate)
curYear = Year(curDate)
firstDay = curMonth & "/" & "01" & "/" & curYear
lastDay = DateAdd("d", -1, DateAdd("m", 1, firstDay))
nextMonth = DateAdd("m", 1, firstDay)
nextMonth = FormatDateTime(Month(nextMonth) & "/" & Day(curDate) & "/" & Year
(nextMonth), 0) & _
"&ctl=" & retControl
prevMonth = DateAdd("m", -1, firstDay)
prevMonth = FormatDateTime(Month(prevMonth) & "/" & Day(curDate) & "/" & Year
(prevMonth), 0) & _
"&ctl=" & retControl
daysCount = CInt(Day(lastDay))
For i = 1 To daysCount
tempDate = curMonth & "/" & i & "/" & curYear
leftC = calcLeft(DatePart("w", tempDate, vbMonday))
topC = calcTop(tempDate)
calHTML = calHTML & _
"

fNumber(Month(tempDate)) & "/" & fNumber(Day(tempDate)) & "/" & Year
(tempDate) & _
"')" & Chr(34) & ">" & Day(tempDate) & "

" & vbCrLf
Next
End If
Function fNumber(fNum)
If Len(Cstr(fNum)) < 2 Then
fNumber = "0" & Cstr(fNum)
Else
fNumber = fNum
End If
End Function
Function calcLeft(wDay)
calcLeft = ((wDay - 1) * 50) + 2
End Function
Function calcTop(wDate)

Dim mStartDate
Dim mStartWeekDay
Dim dRow
mStartDate = Month(wDate) & "/" & "01/" & Year(wDate)
mStartWeekDay = DatePart("w", mStartDate, vbMonday)
dRow = ((mStartWeekDay + CInt(DateDiff("d", mStartDate, wDate))) 7) + 1
If WeekDay(wDate, vbMonday) = 7 Then dRow = dRow - 1
calcTop = ((dRow - 1) * 20) + 1 + TOP_COORDINATE
If dRow > rowCount Then rowCount = dRow
End Function
Function TextMonth(dMonth)
Select Case dMonth
Case 1: TextMonth = "January"
Case 2: TextMonth = "February"
Case 3: TextMonth = "March"
Case 4: TextMonth = "April"
Case 5: TextMonth = "May"
Case 6: TextMonth = "June"
Case 7: TextMonth = "July"
Case 8: TextMonth = "August"
Case 9: TextMonth = "September"
Case 10: TextMonth = "October"
Case 11: TextMonth = "November"
Case 12: TextMonth = "December"
End Select
End Function
%>


Date picker

mon

tue

wed

thu

fri

sat

sun

Previous

Next

转载于:http://blog.itpub.net/7178747/viewspace-161825/