Kalenderscript: lave visning søndag - lørdag om til Mandag - Sønd

Glemte lige denne Function:

' Get the previous sundays date
Function DtPrevSunday(ByVal dt)
    Do While WeekDay(dt) > vbSunday
        dt = DateAdd("d", -1, dt)
    Loop
    DtPrevSunday = dt
End Function

Det er en meget uoverskuelig, og umiddelbart ikke særlig optimal kode ... Har du prøvet at ændre vbSunday til vbMonday _alle_ steder i koden? Incl. i DtPrevSunday Functionen? Og ligeledes vbSaturday til vbSunday..

Ja alt er prøvet med samme resultat - er helt rundforvirret her :-)

Definerer du ikke vbSunday et sted eller er det en indbygget værdi?

Dvs. vbSunday og alle de andre ugedage.

Problemet er jo, at vbSunday svarer til 1 og vbSaturday til 7. Sådan her:

vbSunday=1
vbMonday=2
vbTuesday=3
vbWednesday=4
vbThursday=5
vbFriday=6
vbSaturday=7

Så derfor bliver:
For day=vbMonday To vbSunday
tolket som:
For day=2 To 1

Og det bliver jo naturligvis lidt mærkeligt og giver ikke det korrekte resultat.

Jeg sidder med min næse dybt begravet i en tyk bog om database- og distribuerede systemer (eksamen mandag), så jeg har desværre ikke nok hjernekapacitet til at en kode der virker pt :P

til at lave en kode der virker*

w13>> Ja det kan jeg da godt se... hmmm...smider lige hele den originale kode her:

<!--#include file="config.asp" -->
<%
dim objRs, objCon, dtToday

' open the database
set objCon= Server.CreateObject("ADODB.Connection")
objCon.Open strCon

cat = Request.QueryString("cat")
if cat = "" then
    cat = "all"
End If

'Write a select box
Sub DropDown(tbl, valField, selVal, Field)
    set rsDrop = Server.CreateObject("ADODB.Recordset")
    strSQL = "SELECT DISTINCT " & valField & ", " & Field & " FROM " & tbl & _
        " ORDER BY " & field
    rsDrop.Open strSQL, objCon
    Response.Write "<option value=1>Select...</option>"
    do until rsDrop.EOF
        Response.Write "<option value='"
        Response.Write rsDrop(valfield) & "'"
        Response.Write ">"  & rsDrop(field) & "</option>" & vbcrlf
        rsDrop.MoveNext
    loop
    rsDrop.Close
    set rsDrop=nothing
end sub

' Format the ouput
Function FormatStr(String)
    on Error resume next
    String = Replace(String, CHR(13), "")
    String = Replace(String, CHR(10) & CHR(10), "</P><P>")
    String = Replace(String, CHR(10), "<BR>")
    FormatStr = String
End Function

function dNum(n)
    if n >= 10 then
        dNum = cstr(n)
    Else
        dNum = "0" & cstr(n)
    End If
End Function

'SQL Formatted Date
Function SQLDate(dt)
    SQLDate = cdbl(dt) ' Year(dt) & "-" & DNum(Month(dt))  & "-" &  Dnum(Day(dt)) & " " &  dnum(hour(dt)) & ":" & dnum(Minute(dt))
End Function

' Get the previous sundays date
Function DtPrevSunday(ByVal dt)
    Do While WeekDay(dt) > vbSunday
        dt = DateAdd("d", -1, dt)
    Loop
    DtPrevSunday = dt
End Function

'Todays Date 
dtToday = Date()

Dim dtCurViewMonth ' First day of the currently viewed month
Dim dtCurViewDay ' Current day of the currently viewed month
Dim frmDate ' Date submitted by form

' if the GO button was used, build the date from the month and year
If InStr(1, Request.Form, "subGO", 1) > 0  then
    if Request.Form("CURDATE_month") = "" then
        tmpMonth = month(now())
    else
        tmpMonth = Request.Form("CURDATE_month")
    End If
   
    if Request.Form("CURDATE_year") = "" then
        tmpyear = year(now())
    else
        tmpyear = Request.Form("CURDATE_year")
    End If
       
    tmpDate = "1 " & tmpMonth & " 1999"
   
    mnth = Month(tmpDate)
    frmDate = DateSerial(tmpyear, mnth, 1)
Else
    frmDate = Request.Form("CURDATE")   
end if


if Request("view_date") <> "" then
    frmDate= DateSerial(year(Request("view_date")), month(Request("view_date")), 1)
end if


' if posted from the form
' if prev button was hit on the form
  If InStr(1, Request.Form, "subPrev", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", -1, frmDate)
' if next button was hit on the form
  ElseIf InStr(1, Request.Form, "subNext", 1) > 0 Then
      dtCurViewMonth = DateAdd("m", 1, frmDate)
' anyother time
      Else
' date add in text box
        If InStr(1, Request.Form, "subGO", 1) > 0 then
            dtCurViewMonth = frmDate
        Else
            if Request("view_date") <> "" then
                dtCurviewMonth = frmDate
            else
            dtCurViewMonth = DateSerial(Year(dtToday), Month(dtToday), 1)
            End If
        End If
  End If


Dim iDay, iWeek, sFontColor, dictDte(31,2), intCount 
strSQL ="SELECT diary.id, diary.dte, diary.text_field, Diary_Categorys.Category, Diary_Categorys.Colour, Diary_Categorys.BgColour" & _
        " FROM Diary_Categorys RIGHT JOIN diary ON Diary_Categorys.Cat_ID = diary.Category " & _
        " WHERE month(diary.dte)= " & month(dtCurViewMonth) & " and year(diary.dte) = " & year(dtCurViewMonth)
       
if cat <> "all" then
    strSQL = strSQL & " AND  Diary_Categorys.Cat_ID = " & cat
End If
strSQL = strSQL & "  order by diary.dte"
 
set objRs = objCon.Execute (StrSql)
intCount= 0
 
' populate array with days of month 
tmpDay = ""
 
do until objRs.EOF 
    if day(objRs("dte"))  = tmpDay then
            lnk = "<a href=diary_view.asp?id=" & objRs("id") & " style='color:" & objRs("colour") & _
                "; background:" & objRs("BgColour") & ";" & "font-family:verdana;font-size:8pt;line-height:15px' title='" & cdate(objRs("dte"))  & "'>"  &_
                objRs("text_field") & "</a>"
               
            dictDte(intCount-1, 1) = dictDte(intCount-1, 1) & "<br>" & lnk
              tmpDay = day(objRs("dte"))
            objRs.Movenext
    Else       
        if Day(objRs("dte")) = intCount + 1 then
            lnk = "<a href=diary_view.asp?id=" & objRs("id") & " style='color:" & objRs("colour") & _
                "; background-color:" & objRs("BgColour") & ";" & "font-family:verdana;font-size:8pt;line-height:15px' title='" & cdate(objRs("dte"))  & "'>"  &_
                objRs("text_field") & "</a>"
            dictDte(intCount, 1) = lnk
            tmpDay = day(objRs("dte"))
            objRs.Movenext
            intCount = intCount + 1
        Else
            dictDte(intCount, 1) = " "
            intCount = intCount + 1
        End If           
        dictDte(intCount, 2) = intCount + 1       
    End if
loop
%>
<html>
<head>
<META NAME="ROBOTS" CONTENT="INDEX,NOFOLLOW">
<meta name=vs_targetSchema content="http://schemas.microsoft.com/intellisense/ie5">
<script language="javascript">
<!--

function ChangeBox() {
for (var i = 0; i < document.fmNextPrev.typ.length; i++) {
if (document.fmNextPrev.typ.options[i].selected == true) {
    document.location.href = "diary_viewC.asp?view_date=<%=Request.QueryString("view_date")%>&cat="+document.fmNextPrev.typ[i].value;
}
}
return null
}

//-->
</script>
<link rel="stylesheet" type="text/css" href="diary.css">
</head>
<body>
<form name="fmNextPrev" action="default.asp?cat=<%=cat%>" method="post">
<table cellpadding="3" cellspacing="1" width="95%" border="0" align="center">
    <tr valign="middle">
        <td><a href="default.asp">Today</a> | <a href="diary_manager.asp">Admin</a></td>
        <td colspan="6" align="right">Select an Event Category <select name="typ" onchange="java script:ChangeBox();" id="Select1"><% DropDown "diary_categorys", "cat_id", 1, "category" %></select></td>
    </tr>
</table>
<table cellpadding="3" cellspacing="1" width="95%" border="0" class="maintble" align="center">
    <tr valign="middle" align="center">
        <td colspan="7" class="Item">   
            <table cellpadding="0" cellspacing="0" width="100%" border="0">
                <tr valign="middle" align="center">
                  <td width="30%" align="right">
                      <input type="image" NAME="subPrev" src="images/Left.gif" width="18" height="20">
                  </td>
                  <td width="40%" class="heading2">
                      <%=MonthName(Month(dtCurViewMonth)) & " " & Year(dtCurViewMonth)%>
                  </td>
                  <td width="30%" align="LEFT">
                      <input type="image" name="subNext" src="images/Right.gif" width="18" height="20">
                  </td>
                </tr>
            </table>
          </td>
    </tr>
    <tr valign="top">
        <!-- Start Day of the calendar can be change here  -->
          <% For iDay = vbSunday To vbSaturday %>
            <td width="14%" class="titlebar"><%=WeekDayName(iDay)%></td>
          <%Next %>
    </tr>

<%
dtCurViewDay = DtPrevSunday(dtCurViewMonth)

For iWeek = 0 To 5
    Response.Write "<tr valign=top>" & vbCrLf
    For iDay = vbSunday To vbSaturday
        sBGCOLOR = "cell"
        If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
            If dtCurViewDay = dtToday Then sBGCOLOR = "cellToday"
        else
            sBGCOLOR = "cell"
        End If

        Response.Write "<td height=50 class='" & sBGCOLOR & "'>"       
     
        If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
            if Session("DiaryAdmin") then
                Response.Write "<a href=diary_manager.asp?cat=" & cat & "&" & "view_date=" & SQLDate(dtCurViewday) & ">"
                Response.Write  Day(dtCurViewDay) & "</a></B><br>"
            Else
                Response.Write  Day(dtCurViewDay) & "</B><br>"            
            End If
            Response.Write  formatStr(dictDte(Day(dtCurViewDay)- 1, 1)) & "<BR>"
        End If

        Response.Write "</td>" & vbCrLf
        dtCurViewDay = DateAdd("d", 1, dtCurViewDay)
      Next
      Response.Write "</tr>" & vbCrLf
  Next

%>
</table>
<div align="center">
<select name="CURDATE_month">
<%
for i = 1 to 12
    if i = month(dtCurViewMonth) then
        Response.Write "<option value='" & MonthName(i) & "' Selected>" & MonthName(i) & "</option>" & vbcrlf
    Else
        Response.Write "<option value='" &  MonthName(i) & "'>" & MonthName(i) & "</option>" & vbcrlf
    End If
next
%>
</select>
<input TYPE="text" NAME="CURDATE_YEAR" VALUE="<%=year(dtCurViewMonth)%>" size="6">
<input type="hidden" Name="CURDATE" Value="<%=dtCurViewMonth%>">
<input type=submit value=" GO " name="subGO">
</form>
</div>
</font>
</center>
    <!-- This footer is required by the license terms,  removing it is illegal! --><br />
    <div align="center" class="normal"><a href="http://www.asp-dev.com">Powered by ASP-DEv XM Diary<img src="images/asp-dev-xm.gif" hspace="3" alt="Powered By ASP-DEv XM" border="0" align="absmiddle" /></a></div>
</body>
</html>
<%
on error resume next
objRs.close
objCon.Close
set objrs = nothing
set objCon=nothing
%>

Den kode kan jeg på ingen måde overhovedet overskue. :) Beklager.

Det er ok :-)

Men du havde ret - den skriver dem ud:
1
2
3
4
5
6
7

Måske kunne du - i stedet for at lave en løkke - lægge koden i en funktion.
Så kan du f.eks. kalde funktionen sådan her:

doSomething(vbMonday)
doSomething(vbTuesday)
doSomething(vbWednesday)
doSomething(vbThursday)
doSomething(vbFriday)
doSomething(vbSaturday)
doSomething(vbSunday)

Ja måske - men det kan jeg slet ikke overskue.

De 7 dage skriver den i toppen i celler, under dem kommer der så alle datoerne under de dage hvor de passer ind... :-)

' Get the previous sundays date
Function DtPrevSunday(ByVal dt)
    Do While WeekDay(dt) > vbSunday
        dt = DateAdd("d", -1, dt)
    Loop
    DtPrevSunday = dt
End Function

'Todays Date 
dtToday = Date()

denne function skal du umiddelbart have ændret til mandag.

..