AGENDA (AFFICHAGE DES ÉVÉNEMENTS PROVENANT D'UNE BASE DE DONNÉES SUR UN CALENDRIER)

' ##############################################################
' Agenda.asp
' Affiche un agenda d'événement (configurer ici pour SQL Server)
' Romain Mourer @2002
' romain_mourer@yahoo.fr
' ##############################################################

<!-- #include file='connexion.asp' -->
<%
Function DtPrevSunday(ByVal dt)
	' Cette foction va renvoyer la date du premier jour à afficher sur
	' le calendrier (en général jour du mois précédent)
	Do While WeekDay(dt) > vbSunday
		dt = DateAdd("d", -1, dt)
    Loop
	DtPrevSunday = dt
End Function
'--------------------------------------------------

dim rsEvenement

'----------------------------------------------------------
' Function aganda_recherche_evenement(DateMois)
' Cherche s'il existe un événement à la date donnée
' Argument(s) : DateMois
'----------------------------------------------------------
Function aganda_recherche_evenement(DateMois)
	Set rsRecherche = server.CreateObject("ADODB.Recordset")

	strSql = "SELECT Agenda.* FROM Agenda WHERE " _
		& " month(dateEvenement)= " & month(DateMois) & " and year(dateEvenement) = " & year(DateMois) & " AND day(dateEvenement) = " & day(DateMois) & " ORDER BY DateEvenement"
		
	rsRecherche.Open StrSql, DBConn
	if not rsRecherche.eof then
		aganda_recherche_evenement = "oui"
	else
		aganda_recherche_evenement = "non"
	end if
	
	rsRecherche.close
	set rsRecherche=nothing
End Function

'----------------------------------------------------------
' Function seance_recherche_Annee(DateAVoir)
' Affiche le calendrier de recherche d'un événement
' Argument(s) : DateAVoir
'----------------------------------------------------------
Function agenda_recherche (DateAVoir)
	Dim dtToday 
	dtToday = Date()

	Dim dateMoisCourant ' Date du 1er jour du mois
	Dim dateTmpCourant ' Date du 1er jour à afficher sur le calendrier
						' en général, jour du mois précédent

	' recherche du premier jour du mois
	dateTmp = DateAVoir
	dateJour = day(dateTmp)
	dateTmp = dateadd("d", (-dateJour+1), dateTmp)

	dateMoisCourant = dateTmp

	Dim iDay, iWeek, sFontColor
%>

    <table CELLPADDING="3" class="Agenda" border="0">
		<tr VALIGN="MIDDLE" ALIGN="CENTER">
			<td COLSPAN="7">
				<table CELLPADDING="0" CELLSPACING="0" WIDTH="100%" BORDER="0" width="100%" class="AgendaMois">
					<tr VALIGN="MIDDLE" ALIGN="CENTER">
						<td WIDTH="10%" ALIGN="center">
							<a href="agenda.asp?view_date=<%= dateadd("m", -1, dateMoisCourant) %>"><<</a>
						</td>
						<td WIDTH="80%">
							<font FACE="Arial" COLOR="#000000">
							<b><small><%=MonthName(Month(dateMoisCourant)) & " " & Year(dateMoisCourant)%></small></b>
							</font>
						</td>
						<td WIDTH="10%" ALIGN="center">
							<a href="agenda.asp?view_date=<%= dateadd("m", 1, dateMoisCourant) %>">>></a>
						</td>
					</tr>
				</table>
			</td>
		</tr>
        <tr VALIGN="TOP" ALIGN="CENTER" BGCOLOR="#000099">
	        <% For iDay = vbSunday To vbSaturday %>
            <th WIDTH="14%"><font FACE="Arial" SIZE="-2" COLOR="#FFFFFF"><%=left(WeekDayName(iDay), 3)%></font></th>
		    <%Next %>
        </tr>
<%

	dateTmpCourant = DtPrevSunday(dateMoisCourant)
	
	For iWeek = 0 To 5
		Response.Write "<TR VALIGN=TOP>" & vbCrLf

		Dim sBGCOLOR 
		sBGCOLOR = "#52B4CB"
		sfontColor = "#000000"
		For jour = 0 To 6
			sBGCOLOR = "#52B4CB"
			If Month(dateTmpCourant) = Month(dateMoisCourant) Then
				' Si on est sur le mois en cours
				if cint(Day(dateTmpCourant)) = cint(day(DateAVoir)) then
					' Si jour sélectionné, ou jour d'aujourd'hui
					if (cint(Day(dateTmpCourant)) = cint(day(date()))) AND (Month(dateTmpCourant) = Month(date())) then 
						' Aujourd'hui
						sBGCOLOR = "#0000FF"
					elseif Month(dateTmpCourant) = Month(date()) then
						sBGCOLOR = "#DCF0F4"
						sfontColor = "#FF0000"
					end if
				'else
				'	if cint(Day(dateTmpCourant)) = cint(day(date()))  AND (Month(dateTmpCourant) = Month(date())) then 
						' Aujourd'hui
						'sBGCOLOR = "#0000FF"
				'	elseif Month(dateTmpCourant) = Month(date()) then
				'		sBGCOLOR = "#52B4CB"
				'	end if
					'sBGCOLOR = "#99ccff"
				end if
				
				' On va vérifier s'il y a au moins un évenement ce jour au quel cas on change la couleur
				if aganda_recherche_evenement (day(dateTmpCourant) & "/" & monthname(month(dateTmpCourant)) & "/" & year(dateTmpCourant)) = "oui" then
					sBGCOLOR = "#3BA554"
				end if
			else
				' c'est encore le mois précédent
				sBGCOLOR = "#52B4CB"
			End If
			
			Response.Write "<TD HEIGHT=20 bgcolor='" & sBGCOLOR & "' >"
         
  			If Month(dateTmpCourant) = Month(dateMoisCourant) Then
				If dateTmpCourant = dtToday Then
					sFontColor = "#ff0000"
	            Else
					sFontColor = "#00000"
				End If
             
				Response.Write "<a href=agenda.asp?" & "view_date=" & day(dateTmpCourant) & "/" & monthname(month(dateTmpCourant)) & "/" & year(dateTmpCourant) & ">"
				Response.Write "<FONT FACE=""verdana"" SIZE=""-2"" COLOR=""" & sFontColor & """><B>"
				Response.Write Day(dateTmpCourant) & "</a></B></FONT><BR>"

			End If

			Response.Write "</TD>" & vbCrLf
			dateTmpCourant = DateAdd("d", 1, dateTmpCourant)
		Next
		Response.Write "</TR>" & vbCrLf 
	Next
%>
<%
	Response.Write "</table>"
	
End Function

'--------------------------------------------------------------------------------
' Function seance_rechercher(VoirDate)
' Affiche le résultat de la recherche
' Argument(s) : VoirDate
'				
'--------------------------------------------------------------------------------
Function evenement_recherche (VoirDate)
	
	Set rsEvenement = server.CreateObject("ADODB.Recordset")

	if Request.QueryString("tous") = "jour" then
		strSql = "SELECT Agenda.* FROM Agenda WHERE " _
		& " month(dateEvenement)= " & month(VoirDate) & " and year(dateEvenement) = " & year(VoirDate) & " AND day(dateEvenement) = " & day(VoirDate) & " ORDER BY DateEvenement"
	elseif Request.QueryString("tous") = "mois" then
		strSql = "SELECT Agenda.* FROM Agenda WHERE " _
		& " month(dateEvenement)= " & month(VoirDate) & " and year(dateEvenement) = " & year(VoirDate) & " ORDER BY DateEvenement"
	else
		strSql = "SELECT Agenda.* FROM Agenda WHERE " _
			& " month(dateEvenement)= " & month(VoirDate) & " and year(dateEvenement) = " & year(VoirDate) & " AND day(dateEvenement) = " & day(VoirDate) & " ORDER BY DateEvenement"
	end if
	rsEvenement.Open StrSql, DBConn
	%>
	
<table border="0" cellpadding="0" cellspacing="0" width="100%" height="100%">
	<tr>
		<td width="50%" align="center" height="5" class="haut_milieu"><br>
			<%agenda_recherche("" & VoirDate & "")%>
		</td>
	</tr>
	<tr>
		<td valign="top"><br>
			<div align="center"><font size="1"><b>Liste des évenements du <%=VoirDate%></b></font></div>
			<%
			if rsEvenement.eof then
				Response.Write "<div align=center><br><font face=verdana size=1 color=#000080>Aucun événement ce jour.</font><br></div>"
			end if
			do while not rsEvenement.eof
				if trim(rsEvenement("description")) = ""  then
					Response.Write "<li><font color='#4E6FB7' size='2'><b>" & rsEvenement("Libelle") & "</b></font></li><br>"
				else
					Response.Write "<li><a href='#' onClick='voirEvenement(" & rsEvenement("idAgenda") & ");'><font color='#4E6FB7' size='2'><b><u>" & rsEvenement("Libelle") & "</u></b></font></a></li><br>"
				end if
				rsEvenement.movenext
			Loop
			rsEvenement.close()
			set rsEvenement=nothing
			%>
		</td>
	</tr>
</table>
<%
	DBConn.Close
	set DBConn = nothing
End Function

'----------------------------------
' Affichage de la page
' Appel aux différentes fonctions
'----------------------------------
%>
<html>
<head>
<title>Agenda</title>
<script language="javascript">
function voirEvenement(idEvenement) {
	lien = "user_agenda_fiche.asp?idEvenement=" + idEvenement;
	open(lien,'Agenda','width=700,height=500,toolbar=no,location=no,directories=no,status=no,scrollbars=yes,menubar=no,resizable=yes,top=10,left=10');
}
</script>
</head>
<body bgcolor="#FFFFFF">
<table width="60%" align="center">
	<tr>
		<td align="left" valign="top" width="572" height="395" bgcolor="#FFFFFF">
			<%
			Select Case Request("action")
			case default
				if Request("view_date") <> "" then
					evenement_recherche(Request("view_date"))
				else
					evenement_recherche(date())
				end if
			End Select
			%>
		</td>
	</tr>
</table>
</body>
</html> 

Télécharger le zip