[Codeschnipsel] Gaaaanz simpler Kalender

[Stefan H�sler]

<%
Dim dDatum, dtag, dMonat, dWeekday, dYear, dLastDay, dFirstDay, j

Function fGetLastDay(datum)
 Dim fday, fmonth, fyear, fdate
 fday = Mid(datum,1,2)
 fmonth = Mid(datum,4,2)
 fyear = Mid(datum,7,4)
 FOR fday = 28 TO 32
  fdate = dateserial(fyear, fmonth, fday)
  IF NOT month(fdate) = Cdbl(fmonth) THEN
   fGetLastDay = fday - 1
   EXIT FOR
  END IF
 NEXT
End Function

WITH Response

IF Request("D") = "" THEN
 dDatum = CDate(date())
ELSE
 On Error Resume Next
 dDatum = cDate(Request("D"))
 IF Err.Number <> 0 THEN
  .Write        "Fehler"
  .End
 END IF
 On Error Goto 0
END IF
dTag = Day(dDatum)
dMonat = Month(dDatum)
dMonat = MonthName(dMonat)
dWeekday = Weekday(dDatum,2)
dYear = Year(dDatum)
dLastDay = fGetLastDay(dDatum)
dFirstDay = Weekday(CDate("01." & dMonat & "." & dYear),2)

.Write                  "        <TABLE WIDTH=""98%"" BORDER=""1"" CELLPADDING=""0""
CELLSPACING=""0"" ALIGN=""center"">" & vbNewLine &_
                                "         <TR>" & vbNewLine &_
                                "          <TD>Montag</TD>" & vbNewLine &_
                                "          <TD>Dienstag</TD>" & vbNewLine &_
                                "          <TD>Mittwoch</TD>" & vbNewLine &_
                                "          <TD>Donnerstag</TD>" & vbNewLine &_
                                "          <TD>Freitag</TD>" & vbNewLine &_
                                "          <TD>Samstag</TD>" & vbNewLine &_
                                "          <TD>Sonntag</TD>" & vbNewLine &_
                                "         </TR>" & vbNewLine &_
                                "         <TR>" & vbNewLine
For i = 1 TO dFirstDay - 1
 .Write                 "          <TD>&nbsp;</TD>" & vbNewLine
 j = j + 1
Next
For i = 1 TO fGetLastDay(dDatum)
 IF j = 7 THEN
  .Write                "         </TR>" & vbNewLine &_
                                "         <TR>" & vbNewLine
  j = 0
 END IF
 IF i = dTag THEN
  .Write                "          <TD STYLE=""background-color: #0000FF;"">" & i &
"</TD>" & vbNewLine
 ELSE
  IF Weekday(CDate(i & "." & dMonat & "." & dYear),2) = 6 OR Weekday(CDate(i
& "." & dMonat & "." & dYear),2) = 7 THEN
   .Write               "          <TD STYLE=""background-color: #FF0000;"">" & i &
"</TD>" & vbNewLine
  ELSE
   .Write               "          <TD STYLE=""background-color: #E5E5E5;"">" & i &
"</TD>" & vbNewLine
  END IF
 END IF
 j = j + 1
Next
IF j < 7 THEN
 Do until j = 7
  .Write                "          <TD>&nbsp;</TD>" & vbNewLine
  j = j + 1
 Loop
END IF
.Write                  "         </TR>" & vbNewLine &_
                                "        </TABLE>" & vbNewLine
END WITH
%>


_______________________________________________
Codeschnipsel mailing list
[EMAIL PROTECTED]
http://www.glengamoi.com/mailman/listinfo/codeschnipsel