Mostrar vários compromissos no mesmo dia em forma de calendário

holambra · Outubro 27, 2008

Olá pessoal, normalmente não faço nenhuma postagem, todas as minhas dúvida consigo esclarecer em outros posts, mas hoje tenho uma dúvida que me tirou o fim de semana.

Abaixo segue o código, não consigo mostrar mais do que um evento no mesmo dia.

<%@ LANGUAGE="VBScript" %>
<html>
<head>
<title></title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<link href="default.css" rel="stylesheet" type="text/css">
</head>
<%

Session.LCID = 1046
'Option Explicit

DBCon = "Driver={Microsoft Access Driver (*.mdb)}; DBQ="& Server.MapPath("database/ch.mdb")
set my_conn= Server.CreateObject("ADODB.Connection")
my_Conn.Open DBCon

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

Dim dtToday 
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

%>


<% REM This section defines functions to be used later on. %>
<% REM This sets the Previous Sunday and the Current Month %>
<% 

'--------------------------------------------------
   Function DtPrevSunday(ByVal dt)
	  Do While WeekDay(dt) > vbSunday
		 dt = DateAdd("d", -1, dt)
	  Loop
   DtPrevSunday = dt
   End Function
'--------------------------------------------------
%>

<%REM Set current view month from posted CURDATE,  or
' the current date as appropriate.

' 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
%>

<% REM --------BEGINNING OF DRAW CALENDAR SECTION-------- %>
<% REM This section executes the event query and draws a matching calendar. %>
<%
   Dim iDay, iWeek, sFontColor, dictDte(31,2), intCount
   strSql = "SELECT * FROM agenda WHERE month(data)= " & month(dtCurViewMonth) & " and year(data) = " & year(dtCurViewMonth) & " order by data"
   
   set rs = my_conn.Execute (StrSql)
   
   intCount= 0
   
   ' populate array with days of month
   on Error resume next
   
  
   do until rs.EOF
  
   if intCount > 31 then exit do
   if Day(rs("data")) = intCount + 1 then 
		dictDte(intCount, 1) = rs("titulo")
		rs.Movenext
	Else 
		dictDte(intCount, 1) = " "
	End If
	dictDte(intCount, 2) = intCount + 1
	intCount = intCount + 1
   loop
  
%>
<body leftmargin="0" topmargin="0">
	   <form NAME="fmNextPrev" ACTION="diary.asp" METHOD="POST">
	   <table width="660" border="1" align="center" cellpadding="1" cellspacing="1" bordercolor="#999999">
		  <tr VALIGN="MIDDLE" ALIGN="CENTER">
			 <td COLSPAN="7">
			 <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/prev.gif" BORDER="0" HSPACE="0" VSPACE="0">
				   </td>
				   <td WIDTH="40%">
					  <font FACE="Arial" COLOR="#000000">
					  <b><%=MonthName(Month(dtCurViewMonth)) & " " & Year(dtCurViewMonth)%></b>
					 </font>
				   </td>
				   <td WIDTH="30%" ALIGN="LEFT">
					  <input TYPE="IMAGE" NAME="subNext" SRC="images/prox.gif" BORDER="0" HSPACE="0" VSPACE="0">
				   </td>
				</tr>
			 </table>
			 </td>
		  </tr>

		 <tr bgcolor="#333333">

		  <% For iDay = vbSunday To vbSaturday %>
			 <th WIDTH="14%"><font FACE="Arial" SIZE="1" COLOR="#FFFFFF"><%=WeekDayName(iDay)%></font></th>
		  <%Next %>

		 </tr>

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

Dim sBGCOLOR 
sBGCOLOR = "#99ccff"


For iDay = 0 To 6
sBGCOLOR = "#f5f5f5"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
 If dtCurViewDay = dtToday Then sBGCOLOR = "#cccccc"
else 
 sBGCOLOR = "#f5f5f5"
 
End If
Response.Write "<td height=40 valign=top bgcolor='" & sBGCOLOR & "' >"
		 
	  
   If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
		If dtCurViewDay = dtToday Then
			   sFontColor = "#ff0000"

			Else
			   sFontColor = "#00000"
			End If
	  
		 '---- Write day of month
			Response.Write "<FONT FACE=""Trebuchet MS"" SIZE=""1"" COLOR=""" & sFontColor & """><B>"
			Response.Write "<a class=link4 href=det_agenda.asp?" & "view_date=" & day(dtCurViewday) & "-" & monthname(month(dtCurViewday)) & "-" & year(dtCurViewday) & ">"  & Day(dtCurViewDay) & "</a></B><br>" & formatStr(dictDte(Day(dtCurViewDay)- 1, 1)) & "</FONT>"
		 '---Else
			'---Response.Write " "
		 End If

		 Response.Write "</TD>" & vbCrLf
		 dtCurViewDay = DateAdd("d", 1, dtCurViewDay)
	  Next
	  Response.Write "</TR>" & vbCrLf
   Next
%>
<%REM --------END OF DRAW CALENDAR SECTION-------- 

my_conn.Close
set my_conn = nothing
%>
</table>
<div align="center"><select name="CURDATE_month">
  <option value="<%=monthName(month(dtCurViewMonth))%>" selected><%=monthName(month(dtCurViewMonth))%>
  <option value="January">janeiro
  <option value="February">fevereiro
  <option value="March">março
  <option value="April">abril
  <option value="May">maio
  <option value="June">junho
  <option value="July">julho
  <option value="August">agosto
  <option value="September">setembro
  <option value="October">outubro
  <option value="November">novembro
  <option value="December">dezembro
</select>
<input TYPE="text" NAME="CURDATE_YEAR" VALUE="<%=year(dtCurViewMonth)%>" size="6">
<input type="hidden" Name="CURDATE" Value="<%=dtCurViewMonth%>">
<input type="submit" value=" IR " name="subGO">
</form></div>
</font>
</center>
</body>
</html>

Por favor, me ajudem..

Abraços a todos.

Salgado · Outubro 28, 2008

Poste somente o trecho que faz a exibição do dado na tela.

holambra · Outubro 28, 2008

Oi, Salgado.

Obrigado pelo contato.

ai vai o trecho que exibe os dados.

Response.Write ""

Response.Write "<a class=link4 href=det_agenda.asp?" & "view_date=" & day(dtCurViewday) & "-" & monthname(month(dtCurViewday)) & "-" & year(dtCurViewday) & ">" & Day(dtCurViewDay) & "</a> " & formatStr(dictDte(Day(dtCurViewDay)- 1, 1)) & ""

'---Else

'---Response.Write " "

End If

Response.Write "</TD>" & vbCrLf

dtCurViewDay = DateAdd("d", 1, dtCurViewDay)

Entrar

Arquivado

Mostrar vários compromissos no mesmo dia em forma de calendário

Recommended Posts

holambra 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Salgado 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

holambra 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Estou criando uma calculadora de m2 e litros de tinta

Cruzamento de Bases

Consulta sem duplicação

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante