On Sun, 26 Nov 2000 03:32:58 +0100, "Skydiver" <ln@sky-diver.dk>
wrote:
Er det dette du leder efter?
<%
Session.LCID=1030
'*******************************************
'
'This single ASP page gives the user the abillity to retrive
'a Calendar.
'Done by Bjørn Rønn Ginsborg febuary 2000,
'E-mail: Ginsborg@Get2Net.dk
'Url:
Http://Ginsborg.WebHostMe.Com
'This code is freeware
'
'*******************************************
%>
<HTML>
<HEAD>
<TITLE>Calendar</TITLE>
</HEAD>
<body >
<a name='toppen'></a>
<p>
<%
If Session("aar")="" then
Session("aar")=year(date())
Session("mnd")=Month(date())
else
if request("aar")<>"" then
Session("aar")=Request("aar")
Session("mnd")=Request("mnd")
end if
end if
mnd=session("mnd")
aar=session("aar")
lo "<h4>" & RetMonthLitterals("1/" & trim(mnd) & "/" & trim(aar)) & "
" & aar & "</h4>"
lo "<h5>(danish date settings)</h5>"
FirstDay=CDate( "1/" & mnd & "/" & aar)
LastDay=GetLastDate(mnd,aar)
FirstWeek=datepart("ww",FirstDay,2,2)
LastWeek=datepart("ww",LastDay,2,2)
if mnd=1 and FirstWeek>2 then
aar2=aar-1
else
aar2=aar
end if
if mnd=12 and LastWeek=1 then
aar3=aar+1
else
aar3=aar
end if
FirstWeekNumber=clng(aar2 & LedingZero(FirstWeek))
FirstDateInFirstWeek=Ugenr_til_dato(clng(aar2 &
LedingZero(FirstWeek)))
FirstDateInLastWeek=Ugenr_til_dato(clng(aar3 & LedingZero(LastWeek)))
'lo "<br>FirstDay:" & FirstDay & " "
'lo "<br>LastDay:" & LastDay & " "
'lo "<br>FirstWeekNumber:" & FirstWeekNumber & " "
'lo "<br>FirstDateInFirstWeek:" & FirstDateInFirstWeek & " "
'lo "<br>FirstDateInLastWeek:" & FirstDateInLastWeek
lo "<Table cellpadding=10 border=1><tr>" & _
"<th>Uge</th>" & _
"<th>Ma</th>" & _
"<th>Ti</th>" & _
"<th>On</th>" & _
"<th>To</th>" & _
"<th>Fr</th>" & _
"<th>Lø</th>" & _
"<th>Sø</th>" & _
"</tr>"
for f=FirstDateInFirstWeek to FirstDateInLastWeek step 7
ugenr=clng(DatePart("WW", f, vbMonday, vbFirstFourDays))
lo "<tr>"
lo "<th>" & ugenr & "</th>"
for k=0 to 6
y=DateValue(f+cdate(k))
if cint(month(y))=cint(mnd) then
LColor="Black"
else
LColor="Pink"
end if
dagen=DatePart("d", y, vbMonday, vbFirstFourDays)
lo "<td><Font Color='" & LColor & "'>" & dagen & "</Font></td>"
next
lo "</tr>"
next
lo "</table>"
Function GetLastDay(intMonthNum, intYearNum)
Dim dNextStart
If CInt(intMonthNum) = 12 Then
dNextStart = CDate( "1/1/" & (intYearNum+1))
Else
dNextStart = CDate( "1/" & trim(intMonthNum + 1) & "/" &
intYearNum)
End If
GetLastDay = Day(dNextStart - 1)
End Function
Function GetLastDate(intMonthNum, intYearNum)
Dim dNextStart
If CInt(intMonthNum) = 12 Then
dNextStart = CDate( "1/1/" & (intYearNum+1))
Else
dNextStart = CDate( "1/" & trim(intMonthNum + 1) & "/" &
intYearNum)
End If
GetLastDate = CDate(dNextStart - 1)
End Function
Sub LO(udtekst)
response.write udtekst & vbcrlf
end sub
Function Ugenr_til_dato(ugenummeret)
dim nWeek
dim nYear
Dim FirstDate
Dim Week
nYear = clng(ugenummeret\100)
nWeek = clng(ugenummeret-clng(nYear*100))
' Find den første dato hvor uge nr er 1.
FirstDate = CDate("24-12-" & clng(nYear - 1))
Week = clng(0)
While clng(Week) <> clng(1)
FirstDate = FirstDate + 1
Week = clng(DatePart("WW", CDate(FirstDate), vbMonday,
vbFirstFourDays))
Wend
Ugenr_til_dato = CDate(FirstDate + ((nWeek - 1) * 7))
End Function
Function LedingZero(InTxt)
if len(trim(InTxt))=1 then
LedingZero="0" & trim(InTxt)
else
LedingZero=trim(InTxt)
end if
End Function
Function RetMonthLitterals(DateIn)
Dim OutMonth
Dim FirstSpace
Dim SecondSpace
Dim TempDate
if isdate(DateIn) then
TempDate=FormatDateTime(DateIn,vbLongDate)
FirstSpace=instr(TempDate," ")
SecondSpace=instr(FirstSpace+1,TempDate," ")
RetMonthLitterals=mid(TempDate,FirstSpace+1,SecondSpace-FirstSpace)
else
RetMonthLitterals=DateIn
end if
End Function
%>
<P>
<FORM ACTION="Kal