[Resolvido] Calendário

[Vagner Nunes 0]

Prezados,

 

Gostaria da ajuda dos senhores.

 

Queria saber como faço para implementar em minha página inicial um calendário, onde mostrará eventos do mes e quando clicar no dia apresentar uma janela com os dados do evento. Porém não sei nem como começar.

 

Alguém poderia me ajudar

 

Veja neste site como gostaria de fazer: http://www.univix.br/

 

Sds,

 

Vagner Nunes

[zeke_ 2]

Tabela:

idagenda - numeracao automatica

data - Data/Hora

titulo - Texto

detalhes - Texto

 

calendario.asp

<%@LANGUAGE="VBSCRIPT"%>
<%
'Conexao com o DB
set cn = Server.CreateObject("ADODB.Connection")

'Access
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=agenda.mdb"

%>

<style type="text/css">
<!--
.bordasemana {
	border: 1px solid #CCCCCC;background-color: #EEEEEE;
}
.bordadia {
	border: 1px solid #CCCCCC;background-color: #F8F8F8;

}
.bordadiaatual {
	border: 1px solid #CCCCCC;background-color: #B9CFE7;
}
.bordafds {
	border: 1px solid #CCCCCC;background-color: #BF4422;color:#FFFFFF;
}

table{font-family:Arial, Helvetica, sans-serif; font-size:11px;}
table td{width:30px;}
table td center a{background:#FF9; display:block; color:#000; font-weight:bolder;}
table td center a:hover{background:#06C;}
table td center a:visited{color:#000;}
-->
</style>

<STYLE TYPE="text/css">
<!--
/*BODY {OVERFLOW:scroll;OVERFLOW-X:hidden}*/
.DEK {POSITION:absolute;VISIBILITY:hidden;Z-INDEX:200;}
//-->
</STYLE>
<table width="100%" align="center" border="0" height="100%">
<tr>
<td align="center">
<% 
Function Nome(str)
	strNome = str
	strArray = Split(strNome," ")
	for strN = LBound(strArray) to UBound(strArray)
		strFinal = strFinal & UCase(LEFT(strArray(strN),1)) & LCase(RIGHT(strArray(strN),Len(strArray(strN))-1)) & " "
	next
	Nome = strFinal
End Function
Sub DisplayCalendar(mMonth, yYear) 
	
	dim sToday, nextMonth, pastMonth, dataBrasil, FontColor, CellColor
	
	Classe = ""
	BgColor = "#eeeeee"
	FontColor = "#CCCCCC"
	dDay = DateSerial(yYear,mMonth,1) 
	mMonth = Month(dDay) 
	yYear = Year(dDay)
	if mMonth = 12 then
		MesDepois = Nome(MonthName(1))
	else
		MesDepois = Nome(MonthName(mMonth+1))
	end if
	if mMonth = 1 then
		MesAntes = Nome(MonthName(12))
	else
		MesAntes = Nome(MonthName(mMonth-1))
	end if
	  
	response.write "<table border='0' cellspacing='1' align='center' width='140'>"  
	If Request.QueryString = "" Then
	response.write "<tr><td><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth-1&"&year="&yYear&"""><img src='seta_esq.gif' border='0' alt='Mês anterior: "&MesAntes&"'></a></td><td align='center'><b>"&Nome(MonthName(mMonth))&"</b></td><td align='right'><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth+1&"&year="&yYear&"""><img src='seta_dir.gif' border='0' alt='Próximo mês: "&MesDepois&"'></a></td></tr>" & vbCrlf   
	Else 
	response.write "<tr><td><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth-1&"&year="&yYear&"""><img src='seta_esq.gif' border='0' alt='Mês anterior: "&MesAntes&"'></a></td><td align='center'><b>"&Nome(MonthName(mMonth))&"</b></td><td align='right'><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth+1&"&year="&yYear&"""><img src='seta_dir.gif' border='0' alt='Próximo mês: "&MesDepois&"'></a></td></tr>" & vbCrlf 
	End If 
	response.write "</table>"
	Response.Write "<Table width='140' Border='0' cellpadding='0' cellspacing='1' align='center'>" & vbCrlf 
	Response.Write "<TR Valign='Top' Align='Center'>" & vbCrlf 
		  For i = vbSunday To vbSaturday 
		   
			 Response.Write  "<TD Width='15%' class='bordasemana'><b>" & UCase(left(WeekDayName(i), 1)) & "</b></TD>" & vbCrlf 
			  
		  Next 
	
		Response.Write "</TR>" & vbCrlf 
	
	dDay = DateSerial(yYear,mMonth,1) 
	
	For j = 1 to 6 
	
			Response.Write "<TR>" & vbCrlf 
		
		For i = vbSunday to vbSaturday 
		
				CellStr="" 
				CellColor = "#FDFDFD" 
					
			If WeekDay(dDay) = i and Month(dDay) = mMonth then
				sToday = dDay 
					sData = Day(dDay)&"/"&Month(dDay)&"/"&Year(dDay)
					set eventos = server.CreateObject("ADODB.recordset")
						sqleventos = "select Count(*) as Total from agenda WHERE Day(data) = "&Day(sData)&" AND Month(data) = "&Month(sData)&" AND Year(data) = " & Year(sData)
						eventos.open sqleventos, cn 
						TotalComp = eventos("Total") 
						eventos.Close 
					set eventos = nothing
					sqlEventos = "select * from agenda where Day(data) = "&Day(sData)&" AND Month(data) = "&Month(sData)&" AND Year(data) = "&Year(sData)
					
					set lsEvent = cn.Execute(sqlEventos)
						if NOT lsEvent.EOF then
						
							while NOT lsEvent.EOF
								sTexto = sTexto & "<strong>"&lsEvent("titulo")&":</strong> " & lsEvent("titulo") & "<br>"
								CellColor = "#F00"
								temlink = "sim"
								idagenda = lsEvent("idagenda")
							lsEvent.MoveNext
							Wend
							else
							temlink = "nao"
						end if
					
					
				if Day(dDay) = Day(now) and Month(dDay) = Month(now) and Year(dDay) = Year(now) AND Int(TotalComp) = 0 then
					Classe = "border: 1px solid #CCCCCC; background-color: #B9CFE7;"
					FontColor = "#000000"
				elseif i = 1 then
					if LCase(CellColor) = "#fdfdfd" then
						Classe = "border: 1px solid #CCCCCC; background-color: #BF4422; color:#FFFFFF;"
					else
						Classe = "border: 1px solid #CCCCCC; background-color: "&CellColor&"; color:#FFFFFF;"
					end if
					FontColor = "#FFFFFF"					
				else
					if LCase(CellColor) <> "#fdfdfd" then
						Classe = "border: 1px solid #CCCCCC; background-color: "&CellColor&";"
					else
						Classe = "border: 1px solid #CCCCCC; background-color: #fdfdfd;"
					end if
					FontColor = "#000000"					
				end if
	
				if temlink = "sim" then
				CellStr = "<center><a href=""/?data="&dDay&"&idev="&idagenda&""" >" & Day(dDay) &"</a></center>" 
				Else
				CellStr = "<center>" & Day(dDay) &"</center>"
				 end if
				dDay = DateAdd("d",1,dDay) 
			End If
			if Cellstr <> "" then
				Response.Write "<TD style='"&Classe&"'><font color='"&FontColor&"'>" & CellStr & "</font></TD>" & vbCrlf 
			else
				Response.Write "<TD><font color='"&FontColor&"'>" & CellStr & "</font></TD>" & vbCrlf 
			end if
			
			sTexto = ""
			
		Next 
		
		Response.Write "</TR>" & vbCrlf 
	
	Next 
	
	Response.Write "</Table>" & vbCrlf 
	response.write "<table border='0' align='center' width='140'>"  
	If Request.QueryString = "" Then
	response.write "<tr><td><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth&"&year="&yYear-1&"""><img src='seta_esq.gif' border='0' alt='Ano anterior: "&yYear-1&"'></a></td><td align='center'><b>"&yYear&"</b></td><td align='right'><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth&"&year="&yYear+1&"""><img src='seta_dir.gif' border='0' alt='Próximo ano: "&yYear+1&"'></a></td></tr>" & vbCrlf
	Else
	response.write "<tr><td><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth&"&year="&yYear-1&"""><img src='seta_esq.gif' border='0' alt='Ano anterior: "&yYear-1&"'></a></td><td align='center'><b>"&yYear&"</b></td><td align='right'><a href="""&Request.ServerVariables("SCRIPT_NAME")&"?month="&mMonth&"&year="&yYear+1&"""><img src='seta_dir.gif' border='0' alt='Próximo ano: "&yYear+1&"'></a></td></tr>" & vbCrlf
	End If
	response.write "</table>"
End Sub 


  mMonth = request("month") 
  yYear =  request("year")
  
  if mMonth = "" then mMonth= Month(now)
  if yYear  = "" then yYear = Year(now) 

  if mMonth > 12 then
 	 mMonth = 1
 	 yYear = yYear+1
  end if
  if mMonth < 1 then
 	 mMonth = 12
 	 yYear = yYear-1
  end if
Call DisplayCalendar(mMonth, yYear) 
%>
<br>
    </td>
  </tr>
</table>

Localiza isso no codigo: <a href=""/?data="&dDay&"&idev="&idagenda&"""....

é onde você vai colocar o link da pagina de detalhes.

 

 

Abraços

[Vagner Nunes 0]

Obrigado pessoal pelas dicas. Será de muita utilidade.

 

Valeu mesmo.

 

Sds,

Vagner Nunes

[xanburzum 169]

ok, amigo...