Kalenderprobs
HejJeg ville bruge nedenstående kalender på mit lille private hjemmenetværk, men vi kan ikke helt blive eninge om hvilken ugedag måneden starter med. Nogen der kan løse problemet?
<%@ LANGUAGE=VBSCRIPT %>
<% session.lcid=1030 %>
<!--#INCLUDE FILE=\"adovbs.asp\"-->
<!--#INCLUDE FILE=\"objadodb.asp\"-->
<% session.lcid=1030 %>
<!-- Minus AutoDato -->
<%
Dim Resul,SQL,link
\' ------------------------------------------------------------------------------------
\' Link til side med nærmere beskrivelse
\'-------------------------------------------------------------------------------------
link = \"event.asp\"
SQL = \" SELECT * FROM kalender \"
SET Resul = database.execute(SQL)
%>
<%
Function GetDaysInMonth(iMonth, iYear)
Select Case iMonth
Case 1, 3, 5, 7, 8, 10, 12
GetDaysInMonth = 31
Case 4, 6, 9, 11
GetDaysInMonth = 30
Case 2
If IsDate(\"February 29, \" & iYear) Then
GetDaysInMonth = 29
Else
GetDaysInMonth = 28
End If
End Select
End Function
Function GetWeekdayMonthStartsOn(iMonth, iYear)
GetWeekdayMonthStartsOn = WeekDay(CDate(iMonth & \"/1/\" & iYear))
End Function
Function SubtractOneMonth(dDate)
Dim iDay, iMonth, iYear
iDay = Day(dDate)
iMonth = Month(dDate)
iYear = Year(dDate)
If iMonth = 1 Then
iMonth = 12
iYear = iYear - 1
Else
iMonth = iMonth - 1
End If
If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear)
SubtractOneMonth = CDate(iDay & \"-\" & iMonth & \"-\" & iYear)
End Function
Function AddOneMonth(dDate)
Dim iDay, iMonth, iYear
iDay = Day(dDate)
iMonth = Month(dDate)
iYear = Year(dDate)
If iMonth = 12 Then
iMonth = 1
iYear = iYear + 1
Else
iMonth = iMonth + 1
End If
If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear)
AddOneMonth = CDate(iDay & \"-\" & iMonth & \"-\" & iYear)
End Function
Function FormatMonthName(dMonth)
If dMonth = 1 Then FormatMonthName = \"Januar\"
If dMonth = 2 Then FormatMonthName = \"Februar\"
If dMonth = 3 Then FormatMonthName = \"Marts\"
If dMonth = 4 Then FormatMonthName = \"April\"
If dMonth = 5 Then FormatMonthName = \"Maj\"
If dMonth = 6 Then FormatMonthName = \"Juni\"
If dMonth = 7 Then FormatMonthName = \"Juli\"
If dMonth = 8 Then FormatMonthName = \"August\"
If dMonth = 9 Then FormatMonthName = \"September\"
If dMonth = 10 Then FormatMonthName = \"Oktober\"
If dMonth = 11 Then FormatMonthName = \"November\"
If dMonth = 12 Then FormatMonthName = \"December\"
End Function
Dim dDate \' Date we\'re displaying calendar for
Dim iDIM \' Days In Month
Dim iDOW \' Day Of Week that month starts on
Dim iCurrent \' Variable we use to hold current day of month as we write table
Dim iPosition \' Variable we use to hold current position in table
If IsDate(Request.QueryString(\"date\")) Then
dDate = CDate(Request.QueryString(\"date\"))
Else
If IsDate(Request.QueryString(\"day\") & \"-\" & Request.QueryString(\"month\") & \"-\" & Request.QueryString(\"year\")) Then
dDate = CDate(Request.QueryString(\"day\") & \"-\" & Request.QueryString(\"month\") & \"-\" & Request.QueryString(\"year\"))
Else
dDate = Date()
End If
End If
iDIM = GetDaysInMonth(Month(dDate), Year(dDate))
iDOW = GetWeekdayMonthStartsOn(Month(dDate), Year(dDate))
%>
<html>
<center>
<table border=\"1\" cellspacing=\"0\" cellpadding=\"1\">
<tr>
<td bgcolor=\"blue\" align=\"center\" colspan=\"7\">
<table width=\"100%\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">
<tr>
<td align=\"right\" width=\"20%\"><b><A HREF=\"kalender.asp?date=<%= SubtractOneMonth(ddate) %>\" style=\"color: #FFFFFF\"><--</A></b></TD>
<td align=\"center\" width=\"60%\"><font color=\"#FFFFFF\"><B><%= FormatMonthName(Month(dDate)) & \" \" & Year(dDate) %></B></font></TD>
<td align=\"left\" width=\"20%\"><b><A HREF=\"kalender.asp?date=<%= AddOneMonth(dDate) %>\" style=\"color: #FFFFFF\">--></A></b></TD>
</tr>
</TABLE>
</td>
</tr>
<tr bgcolor=\"blue\">
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Mandag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Tirsdag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Onsdag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Torsdag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Fredag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Lørdag</font></B></TD>
<td ALIGN=\"center\" width=\"80\"><B><font color=\"#FFFFFF\">Søndag</font></B></TD>
</tr>
<%
if iDOW = 1 Then iDOW = 8
If iDOW <> 1 Then
Response.Write(vbTab & \"<tr>\" & vbCrLf)
iPosition = 2
Do While iPosition < iDOW
Response.Write(vbTab & vbTab & \"<td> </td>\" & vbCrLf)
iPosition = iPosition + 1
Loop
End If
\'-- Write days of month in proper day slots --
iCurrent = 1
iPosition = iDOW-1
Do While iCurrent <= iDIM
\'-- open the table row --
If iPosition = 1 Then
Response.Write(vbTab & \"<tr>\" & vbCrLf)
End If
\'-- Write the date and subject --
Response.Write(vbTab & vbTab & \"<td align=left valign=top height=60><b>\" & iCurrent & \"</b>\")
resul.movefirst
Do While NOT Resul.EOF
If Resul(\"Year\") = Year(dDate) Then
If Resul(\"Month\") = Month(dDate) Then
If Resul(\"Day\") = iCurrent Then
Response.Write(\"<BR><font size=2><a href=\" & Chr(34) & link & \"?dato=\" &Resul(\"dato\") & Chr(34) & \" target=opgave>\" & resul(\"overskrift\") & \"</a></font>\")
End If
End If
End If
resul.MoveNext
Loop
Response.Write(\"</td>\" & vbCrLf)
\'-- Close the table row --
If iPosition = 7 Then
Response.Write vbTab & \"</tr>\" & vbCrLf
iPosition = 0
End If
\'-- Increment variables --
iCurrent = iCurrent + 1
iPosition = iPosition + 1
Loop
If iPosition <> 1 Then
Do While iPosition <= 7
Response.Write(vbTab & vbTab & \"<td> </td>\" & vbCrLf)
iPosition = iPosition + 1
Loop
Response.Write vbTab & \"</TR>\" & vbCrLf
End If
%>
</table>
</center>
</html>
